From 11d20228f1789f0f29796740d77e34cd21526bdc Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 16 Jun 2010 17:42:15 -0500
Subject: [PATCH] Implement set-time on Windows

---
 basis/calendar/windows/windows.factor  | 27 +++++++++++++++++++++++++-
 basis/windows/kernel32/kernel32.factor |  2 +-
 extra/time/time.factor                 |  9 ++++++++-
 extra/time/windows/authors.txt         |  1 +
 extra/time/windows/windows.factor      | 12 ++++++++++++
 5 files changed, 48 insertions(+), 3 deletions(-)
 create mode 100644 extra/time/windows/authors.txt
 create mode 100644 extra/time/windows/windows.factor

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 ;
-- 
2.34.1