Implement set-time on Windows

diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor
index 265a58507c739dfc1b254ef0fdc4b32110fcd676..abec2dcf9fd59a995e3f7d540805f40ada459cd3 100644 (file)
--- a/basis/calendar/windows/windows.factor
+++ b/basis/calendar/windows/windows.factor
@@ -1,6 +1,6 @@
 USING: calendar namespaces alien.c-types system
 windows.kernel32 kernel math combinators windows.errors
-accessors classes.struct ;
+accessors classes.struct calendar.format math.functions ;
 IN: calendar.windows
 
 M: windows gmt-offset ( -- hours minutes seconds )
@@ -11,3 +11,28 @@ M: windows gmt-offset ( -- hours minutes seconds )
         { TIME_ZONE_ID_STANDARD [ Bias>> ] }
         { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
     } case neg 60 /mod 0 ;
+
+: timestamp>SYSTEMTIME ( timestamp -- SYSTEMTIME )
+    {
+        [ year>> ]
+        [ month>> ]
+        [ day-of-week ]
+        [ day>> ]
+        [ hour>> ]
+        [ minute>> ]
+        [
+            second>> dup floor
+            [ nip >integer ]
+            [ - 1000 * >integer ] 2bi
+        ]
+    } cleave \ SYSTEMTIME <struct-boa> ;
+
+: SYSTEMTIME>timestamp ( SYSTEMTIME -- timestamp )
+    {
+        [ wYear>> ]
+        [ wMonth>> ]
+        [ wDay>> ]
+        [ wHour>> ]
+        [ wMinute>> ]
+        [ [ wSecond>> ] [ wMilliseconds>> 1000 /f ] bi + ]
+    } cleave gmt-offset-duration <timestamp> ;

diff --git a/basis/windows/kernel32/kernel32.factor b/basis/windows/kernel32/kernel32.factor
index 94cedef38aa0dafef003f5d010b7571b982fff73..be11fc66a0ad8ae871df1b917450f8623861cdd7 100644 (file)
--- a/basis/windows/kernel32/kernel32.factor
+++ b/basis/windows/kernel32/kernel32.factor
@@ -1800,7 +1800,7 @@ FUNCTION: BOOL SetProcessPriorityBoost ( HANDLE hProcess, BOOL disablePriorityBo
 ! FUNCTION: SetProcessWorkingSetSize
 ! FUNCTION: SetStdHandle
 ! FUNCTION: SetSystemPowerState
-! FUNCTION: SetSystemTime
+FUNCTION: BOOL SetSystemTime ( SYSTEMTIME* lpSystemTime ) ;
 ! FUNCTION: SetSystemTimeAdjustment
 ! FUNCTION: SetTapeParameters
 ! FUNCTION: SetTapePosition

diff --git a/extra/time/time.factor b/extra/time/time.factor
index 45ba3bc14165fc99ce101bf748799f2080209c61..61a4d7415e9ad0572eca1440c5da3e5c1cde8100 100644 (file)
--- a/extra/time/time.factor
+++ b/extra/time/time.factor
@@ -1,7 +1,14 @@
 ! Copyright (C) 2010 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: system ;
+USING: combinators kernel system vocabs.loader ;
 IN: time
 
 HOOK: set-time os ( timestamp -- )
 HOOK: adjust-time-monotonic os ( timestamp -- seconds )
+
+os {
+    { [ dup macosx? ] [ drop "time.macosx" require ] }
+    { [ dup windows? ] [ drop "time.windows" require ] }
+    { [ dup unix? ] [ drop "time.unix" require ] }
+    [ drop ]
+} cond

diff --git a/extra/time/windows/authors.txt b/extra/time/windows/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/extra/time/windows/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/extra/time/windows/windows.factor b/extra/time/windows/windows.factor
new file mode 100644 (file)
index 0000000..1f2259d
--- /dev/null
+++ b/extra/time/windows/windows.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2010 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: calendar.windows system time windows.errors 
+windows.kernel32 kernel classes.struct calendar ;
+IN: time.windows
+
+: windows-system-time ( -- SYSTEMTIME )
+    SYSTEMTIME <struct> [ GetSystemTime ] keep ;
+
+M: windows set-time
+    >gmt
+    timestamp>SYSTEMTIME SetSystemTime win32-error=0/f ;