diff --git a/core/io/streams/c/c.factor b/core/io/streams/c/c.factor index 288ab212d1..48d6e6e430 100755 --- a/core/io/streams/c/c.factor +++ b/core/io/streams/c/c.factor @@ -64,7 +64,7 @@ M: object init-stdio stdin-handle stdout-handle stdio set-global stderr-handle stderr set-global ; -M: object io-multiplex (sleep) ; +M: object io-multiplex 60 60 * 1000 * or (sleep) ; M: object "rb" fopen ; diff --git a/core/io/thread/thread.factor b/core/io/thread/thread.factor index 53ab5193c6..fe86ba9e3d 100755 --- a/core/io/thread/thread.factor +++ b/core/io/thread/thread.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: io.thread -USING: threads io.backend namespaces init ; +USING: threads io.backend namespaces init math ; : io-thread ( -- ) sleep-time io-multiplex yield ; diff --git a/core/threads/threads.factor b/core/threads/threads.factor index 7a059c8fbe..2472dac52f 100755 --- a/core/threads/threads.factor +++ b/core/threads/threads.factor @@ -113,7 +113,7 @@ PRIVATE> PRIVATE> -: sleep-time ( -- ms ) +: sleep-time ( -- ms/f ) { { [ run-queue dlist-empty? not ] [ 0 ] } { [ sleep-queue heap-empty? ] [ f ] } @@ -134,18 +134,21 @@ PRIVATE> : yield ( -- ) [ resume ] "yield" suspend drop ; : nap ( ms/f -- ? ) - [ - >fixnum millis + [ schedule-sleep ] curry "sleep" - ] [ - [ drop ] "interrupt" - ] if* suspend ; + [ >fixnum millis + [ schedule-sleep ] curry "sleep" ] + [ [ drop ] "interrupt" ] if* + suspend ; : sleep ( ms -- ) nap [ "Sleep interrupted" throw ] when ; : interrupt ( thread -- ) - dup thread-sleep-entry [ sleep-queue heap-delete ] when* - t swap resume-with ; + dup self eq? [ + drop + ] [ + dup thread-sleep-entry [ sleep-queue heap-delete ] when* + f over set-thread-sleep-entry + t swap resume-with + ] if ; : (spawn) ( thread -- ) [ diff --git a/extra/alarms/alarms-docs.factor b/extra/alarms/alarms-docs.factor index a53515a68d..6591e61623 100755 --- a/extra/alarms/alarms-docs.factor +++ b/extra/alarms/alarms-docs.factor @@ -1,5 +1,5 @@ IN: alarms -USING: help.markup help.syntax calendar ; +USING: help.markup help.syntax calendar quotations ; HELP: alarm { $class-description "An alarm. Cancel passed to " { $link cancel-alarm } "." } ; diff --git a/extra/alarms/alarms.factor b/extra/alarms/alarms.factor index 5a48cd9a10..165a081faa 100755 --- a/extra/alarms/alarms.factor +++ b/extra/alarms/alarms.factor @@ -8,6 +8,12 @@ TUPLE: alarm time interval quot entry ; ( time delay quot -- alarm ) check-alarm alarm construct-boa ; -SYMBOL: alarms -SYMBOL: alarm-thread - -: notify-alarm-thread ( -- ) - alarm-thread get-global interrupt ; +: register-alarm ( alarm -- ) + dup dup alarm-time alarms get-global heap-push* + swap alarm-entry >box + notify-alarm-thread ; : alarm-expired? ( alarm now -- ? ) >r alarm-time r> <=> 0 <= ; @@ -28,7 +33,7 @@ SYMBOL: alarm-thread : reschedule-alarm ( alarm -- ) dup alarm-time over alarm-interval +dt over set-alarm-time - add-alarm drop ; + register-alarm ; : call-alarm ( alarm -- ) dup alarm-quot try @@ -52,10 +57,9 @@ SYMBOL: alarm-thread : next-alarm ( alarms -- ms ) dup heap-empty? - [ drop f ] [ - heap-peek drop alarm-time now - [ timestamp>unix-time ] 2apply [-] 1000 * - ] if ; + [ drop f ] + [ heap-peek drop alarm-time now timestamp- 1000 * 0 max ] + if ; : alarm-thread-loop ( -- ) alarms get-global @@ -73,11 +77,7 @@ SYMBOL: alarm-thread PRIVATE> : add-alarm ( time frequency quot -- alarm ) - [ - dup dup alarm-time alarms get-global heap-push* - swap alarm-entry >box - notify-alarm-thread - ] keep ; + [ register-alarm ] keep ; : cancel-alarm ( alarm -- ) alarm-entry box> alarms get-global heap-delete ; diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 86dc973a9a..165f35bce2 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -223,7 +223,13 @@ M: timestamp <=> ( ts1 ts2 -- n ) [ >time< >r >r 3600 * r> 60 * r> + + ] 2apply - + ; : unix-1970 ( -- timestamp ) - 1970 1 1 0 0 0 0 ; foldable + 1970 1 1 0 0 0 0 ; + +: millis>timestamp ( n -- timestamp ) + >r unix-1970 r> 1000 /f seconds +dt ; + +: timestamp>millis ( timestamp -- n ) + unix-1970 timestamp- 1000 * >integer ; : unix-time>timestamp ( n -- timestamp ) >r unix-1970 r> seconds +dt ; diff --git a/extra/io/timeouts/timeouts-docs.factor b/extra/io/timeouts/timeouts-docs.factor index c03520bb56..347c57a0d6 100755 --- a/extra/io/timeouts/timeouts-docs.factor +++ b/extra/io/timeouts/timeouts-docs.factor @@ -25,7 +25,6 @@ ARTICLE: "io.timeouts" "I/O timeout protocol" { $subsection timed-out } "A combinator to be used in operations which can time out:" { $subsection with-timeout } -{ $see-also "stream-protocol" "io.launcher" } -; +{ $see-also "stream-protocol" "io.launcher" } ; ABOUT: "io.timeouts" diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index f31c67e0eb..fe2f63e99a 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -178,7 +178,7 @@ M: write-task do-io-task M: port port-flush ( port -- ) dup buffer-empty? [ drop ] [ (wait-to-write) ] if ; -M: unix-io io-multiplex ( ms -- ) +M: unix-io io-multiplex ( ms/f -- ) mx get-global wait-for-events ; M: unix-io init-stdio ( -- ) diff --git a/extra/io/unix/kqueue/kqueue.factor b/extra/io/unix/kqueue/kqueue.factor index 04bb70d57d..7b67a9d468 100755 --- a/extra/io/unix/kqueue/kqueue.factor +++ b/extra/io/unix/kqueue/kqueue.factor @@ -66,7 +66,8 @@ M: kqueue-mx unregister-io-task ( task mx -- ) [ over kqueue-mx-events kevent-nth handle-kevent ] with each ; M: kqueue-mx wait-for-events ( ms mx -- ) - swap make-timespec dupd wait-kevent handle-kevents ; + swap dup [ make-timespec ] when + dupd wait-kevent handle-kevents ; : make-proc-kevent ( pid -- kevent ) "kevent" diff --git a/extra/io/unix/select/select.factor b/extra/io/unix/select/select.factor index 9827d4d54f..77a20beb42 100755 --- a/extra/io/unix/select/select.factor +++ b/extra/io/unix/select/select.factor @@ -49,7 +49,7 @@ TUPLE: select-mx read-fdset write-fdset ; f ; M: select-mx wait-for-events ( ms mx -- ) - swap >r dup init-fdsets r> make-timeval + swap >r dup init-fdsets r> dup [ make-timeval ] when select multiplexer-error dup read-fdset/tasks pick handle-fdset dup write-fdset/tasks rot handle-fdset ; diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index e90a9f16e2..d92b4db77c 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -7,7 +7,9 @@ IN: io.windows.ce.backend : port-errored ( port -- ) win32-error-string swap set-port-error ; -M: windows-ce-io io-multiplex ( ms -- ) (sleep) ; +M: windows-ce-io io-multiplex ( ms -- ) + 60 60 * 1000 * or (sleep) ; + M: windows-ce-io add-completion ( handle -- ) drop ; GENERIC: wince-read ( port port-handle -- ) diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 50b199b3bd..10e55ed5f2 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -57,7 +57,8 @@ M: windows-nt-io add-completion ( handle -- ) ] "I/O" suspend 3drop ; : wait-for-overlapped ( ms -- overlapped ? ) - >r master-completion-port get-global r> ! port ms + >r master-completion-port get-global + r> INFINITE or ! timeout 0 ! bytes f ! key f ! overlapped diff --git a/extra/models/models-docs.factor b/extra/models/models-docs.factor index 92ea6ced95..ce86905b9f 100755 --- a/extra/models/models-docs.factor +++ b/extra/models/models-docs.factor @@ -1,4 +1,5 @@ -USING: help.syntax help.markup kernel math classes tuples ; +USING: help.syntax help.markup kernel math classes tuples +calendar ; IN: models HELP: model @@ -142,18 +143,18 @@ HELP: delay { $examples "The following code displays a sliders and a label which is updated half a second after the slider stops changing:" { $code - "USING: models ui.gadgets.labels ui.gadgets.sliders ui.gadgets.panes ;" + "USING: models ui.gadgets.labels ui.gadgets.sliders ui.gadgets.panes calendar ;" ": " " 0 0 0 100 500 over set-slider-max ;" " dup gadget." - "gadget-model 500 [ number>string ] " + "gadget-model 1/2 seconds [ number>string ] " " gadget." } } ; HELP: -{ $values { "model" model } { "timeout" "a positive integer" } { "delay" delay } } -{ $description "Creates a new instance of " { $link delay } ". A timer of " { $snippet "timeout" } " milliseconds must elapse from the time the underlying model last changed to when the delay model value is changed and its connections are notified." } +{ $values { "model" model } { "timeout" dt } { "delay" delay } } +{ $description "Creates a new instance of " { $link delay } ". The timeout must elapse from the time the underlying model last changed to when the delay model value is changed and its connections are notified." } { $examples "See the example in the documentation for " { $link delay } "." } ; HELP: range-value diff --git a/extra/models/models.factor b/extra/models/models.factor index 6d2b0907c5..f9d3f57123 100755 --- a/extra/models/models.factor +++ b/extra/models/models.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: generic kernel math sequences arrays assocs alarms ; +USING: generic kernel math sequences arrays assocs alarms +calendar ; IN: models TUPLE: model value connections dependencies ref locked? ; @@ -186,14 +187,14 @@ TUPLE: delay model timeout alarm ; [ add-dependency ] keep ; : cancel-delay ( delay -- ) - delay-model-alarm [ cancel-alarm ] when* ; + delay-alarm [ cancel-alarm ] when* ; : start-delay ( delay -- ) - now over delay-model-timeout dt+ f + now over delay-timeout +dt f pick [ f over set-delay-alarm update-delay-model ] curry - add-alarm swap set-delay-model-alarm ; + add-alarm swap set-delay-alarm ; -M: delay model-changed nip start-delay ; +M: delay model-changed nip dup cancel-delay start-delay ; M: delay model-activated update-delay-model ; diff --git a/extra/ui/gadgets/status-bar/status-bar.factor b/extra/ui/gadgets/status-bar/status-bar.factor old mode 100644 new mode 100755 index c5508e1891..b528d6739c --- a/extra/ui/gadgets/status-bar/status-bar.factor +++ b/extra/ui/gadgets/status-bar/status-bar.factor @@ -1,11 +1,12 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: models sequences ui.gadgets.labels ui.gadgets.theme -ui.gadgets.tracks ui.gadgets.worlds ui.gadgets ui kernel ; +ui.gadgets.tracks ui.gadgets.worlds ui.gadgets ui kernel +calendar ; IN: ui.gadgets.status-bar : ( model -- gadget ) - 100 [ "" like ] + 1/10 seconds [ "" like ] dup reverse-video-theme t over set-gadget-root? ; diff --git a/extra/ui/gestures/gestures.factor b/extra/ui/gestures/gestures.factor index 2d3e8f6835..e9a24d702f 100755 --- a/extra/ui/gestures/gestures.factor +++ b/extra/ui/gestures/gestures.factor @@ -1,8 +1,9 @@ -! Copyright (C) 2005, 2007 Slava Pestov. +! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs kernel math models namespaces sequences words strings system hashtables math.parser -math.vectors tuples classes ui.gadgets combinators.lib ; +math.vectors tuples classes ui.gadgets combinators.lib boxes +calendar alarms ; IN: ui.gestures : set-gestures ( class hash -- ) "gestures" set-word-prop ; @@ -113,7 +114,7 @@ SYMBOL: drag-timer : start-drag-timer ( -- ) hand-buttons get-global empty? [ - now 300 milliseconds dt+ 100 milliseconds + now 300 milliseconds +dt 100 milliseconds [ drag-gesture ] add-alarm drag-timer get-global >box ] when ; diff --git a/extra/ui/tools/interactor/interactor.factor b/extra/ui/tools/interactor/interactor.factor index a7b1568cf9..3c9809f343 100755 --- a/extra/ui/tools/interactor/interactor.factor +++ b/extra/ui/tools/interactor/interactor.factor @@ -6,7 +6,7 @@ math.vectors models namespaces parser prettyprint quotations sequences sequences.lib strings threads listener tuples ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.presentations ui.gadgets.worlds ui.gestures -definitions boxes ; +definitions boxes calendar ; IN: ui.tools.interactor TUPLE: interactor @@ -29,7 +29,8 @@ help ; ] if ; : init-caret-help ( interactor -- ) - dup editor-caret 100 swap set-interactor-help ; + dup editor-caret 1/3 seconds + swap set-interactor-help ; : init-interactor-history ( interactor -- ) V{ } clone swap set-interactor-history ; diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor index 4bf89d03d1..978ca295ca 100755 --- a/extra/ui/tools/search/search.factor +++ b/extra/ui/tools/search/search.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006, 2007 Slava Pestov. +! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs ui.tools.interactor ui.tools.listener ui.tools.workspace help help.topics io.files io.styles kernel @@ -7,7 +7,7 @@ source-files strings tools.completion tools.crossref tuples ui.commands ui.gadgets ui.gadgets.editors ui.gadgets.lists ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.operations vocabs words vocabs.loader -tools.browser unicode.case ; +tools.browser unicode.case calendar ; IN: ui.tools.search TUPLE: live-search field list ; @@ -45,7 +45,7 @@ search-field H{ } set-gestures : ( producer -- model ) - >r g live-search-field gadget-model 200 + >r g live-search-field gadget-model 1/5 seconds [ "\n" join ] r> append ; : ( seq limited? presenter -- gadget ) diff --git a/extra/windows/windows.factor b/extra/windows/windows.factor index e07c504781..600c0a4039 100755 --- a/extra/windows/windows.factor +++ b/extra/windows/windows.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2006 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.syntax alien.c-types arrays combinators -io io.nonblocking kernel math namespaces parser prettyprint -sequences windows.errors windows.types windows.kernel32 words ; +kernel math namespaces parser prettyprint sequences +windows.errors windows.types windows.kernel32 words ; IN: windows : lo-word ( wparam -- lo ) *short ; inline