From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 16 Jun 2010 22:42:15 +0000 (-0500)
Subject: Implement set-time on Windows
X-Git-Tag: 0.97~4692^2~4^2~13
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=11d20228f1789f0f29796740d77e34cd21526bdc

Implement set-time on Windows
---

diff --git a/basis/calendar/windows/windows.factor b/basis/calendar/windows/windows.factor
index 265a58507c..abec2dcf9f 100644
--- 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 94cedef38a..be11fc66a0 100644
--- 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 45ba3bc141..61a4d7415e 100644
--- 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
index 0000000000..7c1b2f2279
--- /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
index 0000000000..1f2259d137
--- /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 ;