Fixes

core/io/streams/c/c.factor

@@ -64,7 +64,7 @@ M: object init-stdio
     stdin-handle stdout-handle <duplex-c-stream> stdio set-global
     stderr-handle <c-writer> <plain-writer> stderr set-global ;
 
-M: object io-multiplex (sleep) ;
+M: object io-multiplex 60 60 * 1000 * or (sleep) ;
 
 M: object <file-reader>
     "rb" fopen <c-reader> <line-reader> ;

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 ;

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" ]
-        >fixnum millis + [ schedule-sleep ] curry "sleep"
+    [ [ drop ] "interrupt" ] if*
-    ] [
+    suspend ;
-        [ drop ] "interrupt"
-    ] if* suspend ;
 
 : sleep ( ms -- )
     nap [ "Sleep interrupted" throw ] when ;
 
 : interrupt ( thread -- )
-    dup thread-sleep-entry [ sleep-queue heap-delete ] when*
+    dup self eq? [
-    t swap resume-with ;
+        drop
+    ] [
+        dup thread-sleep-entry [ sleep-queue heap-delete ] when*
+        f over set-thread-sleep-entry
+        t swap resume-with
+    ] if ;
 
 : (spawn) ( thread -- )
     [

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 } "." } ;

extra/alarms/alarms.factor

@@ -8,6 +8,12 @@ TUPLE: alarm time interval quot entry ;
 
 <PRIVATE
 
+SYMBOL: alarms
+SYMBOL: alarm-thread
+
+: notify-alarm-thread ( -- )
+    alarm-thread get-global interrupt ;
+
 : check-alarm
     pick timestamp? [ "Not a timestamp" throw ] unless
     over dup dt? swap not or [ "Not a dt" throw ] unless
@@ -16,11 +22,10 @@ TUPLE: alarm time interval quot entry ;
 : <alarm> ( time delay quot -- alarm )
     check-alarm <box> alarm construct-boa ;
 
-SYMBOL: alarms
+: register-alarm ( alarm -- )
-SYMBOL: alarm-thread
+    dup dup alarm-time alarms get-global heap-push*
-
+    swap alarm-entry >box
-: notify-alarm-thread ( -- )
+    notify-alarm-thread ;
-    alarm-thread get-global interrupt ;
 
 : 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 ] [
+    [ drop f ]
-        heap-peek drop alarm-time now
+    [ heap-peek drop alarm-time now timestamp- 1000 * 0 max ]
-        [ timestamp>unix-time ] 2apply [-] 1000 *
+    if ;
-    ] if ;
 
 : alarm-thread-loop ( -- )
     alarms get-global
@@ -73,11 +77,7 @@ SYMBOL: alarm-thread
 PRIVATE>
 
 : add-alarm ( time frequency quot -- alarm )
-    <alarm> [
+    <alarm> [ register-alarm ] keep ;
-        dup dup alarm-time alarms get-global heap-push*
-        swap alarm-entry >box
-        notify-alarm-thread
-    ] keep ;
 
 : cancel-alarm ( alarm -- )
     alarm-entry box> alarms get-global heap-delete ;

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 <timestamp> ; foldable
+    1970 1 1 0 0 0 0 <timestamp> ;
+
+: 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 ;

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"

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 ( -- )

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" <c-object>

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 ;

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 -- )

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 <int> ! bytes
     f <void*> ! key
     f <void*> ! overlapped

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 ;"
         ": <funny-slider>"
         "    0 0 0 100 <range> <x-slider> 500 over set-slider-max ;"
         "<funny-slider> dup gadget."
-        "gadget-model 500 <delay> [ number>string ] <filter>"
+        "gadget-model 1/2 seconds <delay> [ number>string ] <filter>"
         "<label-control> gadget."
     }
 } ;
 
 HELP: <delay>
-{ $values { "model" model } { "timeout" "a positive integer" } { "delay" delay } }
+{ $values { "model" model } { "timeout" dt } { "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." }
+{ $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

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 ;
 

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
 
 : <status-bar> ( model -- gadget )
-    100 <delay> [ "" like ] <filter> <label-control>
+    1/10 seconds <delay> [ "" like ] <filter> <label-control>
     dup reverse-video-theme
     t over set-gadget-root? ;
 

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 ;
 

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 <delay> swap set-interactor-help ;
+    dup editor-caret 1/3 seconds <delay>
+    swap set-interactor-help ;
 
 : init-interactor-history ( interactor -- )
     V{ } clone swap set-interactor-history ;

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
 
 : <search-model> ( producer -- model )
-    >r g live-search-field gadget-model 200 <delay>
+    >r g live-search-field gadget-model 1/5 seconds <delay>
     [ "\n" join ] r> append <filter> ;
 
 : <search-list> ( seq limited? presenter -- gadget )

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
+kernel math namespaces parser prettyprint sequences
-sequences windows.errors windows.types windows.kernel32 words ;
+windows.errors windows.types windows.kernel32 words ;
 IN: windows
 
 : lo-word ( wparam -- lo ) <short> *short ; inline