[MLton-commit] r5216

[Vesa Karvonen]

Added keyOf for extracting the hkey from the result of createKeyEx.  Added
some EventLog type constants (flags).

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/windows/unstable/detail/ffi/windows.h
U   mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml
U   mltonlib/trunk/com/ssh/windows/unstable/public/windows.sig

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/windows/unstable/detail/ffi/windows.h
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/detail/ffi/windows.h	2007-02-16 09:59:41 UTC (rev 5215)
+++ mltonlib/trunk/com/ssh/windows/unstable/detail/ffi/windows.h	2007-02-16 14:43:20 UTC (rev 5216)
@@ -28,6 +28,7 @@
 /************************************************************************/
 
 WIN_TYPEDEF(BYTE, unsigned char);
+WIN_TYPEDEF(WORD, unsigned short);
 WIN_TYPEDEF(DWORD, unsigned long);
 WIN_TYPEDEF(LONG, long);
 
@@ -126,6 +127,14 @@
 
 /************************************************************************/
 
+WIN_CONST(EVENTLOG_ERROR_TYPE, WORD);
+WIN_CONST(EVENTLOG_AUDIT_FAILURE, WORD);
+WIN_CONST(EVENTLOG_AUDIT_SUCCESS, WORD);
+WIN_CONST(EVENTLOG_INFORMATION_TYPE, WORD);
+WIN_CONST(EVENTLOG_WARNING_TYPE, WORD);
+
+/************************************************************************/
+
 LPTSTR win_FormatErrorLocalAlloc(DWORD error);
 
 #endif

Modified: mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml	2007-02-16 09:59:41 UTC (rev 5215)
+++ mltonlib/trunk/com/ssh/windows/unstable/detail/windows.sml	2007-02-16 14:43:20 UTC (rev 5216)
@@ -4,6 +4,8 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
+(* XXX pretty print the arguments to functions in error messages *)
+
 (* Implementation of Windows utilities. *)
 structure Windows :> WINDOWS = struct
    val op >>& = With.>>&
@@ -116,6 +118,8 @@
         = CREATED_NEW_KEY of hkey
         | OPENED_EXISTING_KEY of hkey
 
+      val keyOf = fn CREATED_NEW_KEY k => k | OPENED_EXISTING_KEY k => k
+
       fun createKeyEx (hKey, subKey, samDesired) =
           (withZs subKey >>& withPtr >>& withDword)
              (fn subKey & hkResult & dwDisposition =>
@@ -254,6 +258,19 @@
       end
    end
 
+   structure EventLog = struct
+      structure Type = struct
+         open BitFlags
+         val ` = SysWord.fromInt o MLRep.Short.Unsigned.toIntX o C.Get.ushort' o
+                 pass ()
+         val auditFailure = `G_win_EVENTLOG_AUDIT_FAILURE.obj'
+         val auditSuccess = `G_win_EVENTLOG_AUDIT_SUCCESS.obj'
+         val error = `G_win_EVENTLOG_ERROR_TYPE.obj'
+         val information = `G_win_EVENTLOG_INFORMATION_TYPE.obj'
+         val warning = `G_win_EVENTLOG_WARNING_TYPE.obj'
+      end
+   end
+
    structure Module = struct
       type hmodule = C.voidptr
 

Modified: mltonlib/trunk/com/ssh/windows/unstable/public/windows.sig
===================================================================
--- mltonlib/trunk/com/ssh/windows/unstable/public/windows.sig	2007-02-16 09:59:41 UTC (rev 5215)
+++ mltonlib/trunk/com/ssh/windows/unstable/public/windows.sig	2007-02-16 14:43:20 UTC (rev 5216)
@@ -14,7 +14,6 @@
 signature WINDOWS = sig
    structure Key : sig
       include BIT_FLAGS
-
       val allAccess : flags
       val createLink : flags
       val createSubKey : flags
@@ -29,7 +28,6 @@
 
    structure Reg : sig
       eqtype hkey
-
       val classesRoot : hkey
       val currentConfig : hkey
       val currentUser : hkey
@@ -41,6 +39,8 @@
       datatype create_result
         = CREATED_NEW_KEY of hkey
         | OPENED_EXISTING_KEY of hkey
+      val keyOf : create_result -> hkey
+
       val closeKey : hkey Effect.t
       val createKeyEx : hkey * String.t * Key.flags -> create_result
       val deleteKey : (hkey * String.t) Effect.t
@@ -60,6 +60,17 @@
       val setValueEx : (hkey * String.t * value) Effect.t
    end
 
+   structure EventLog : sig
+      structure Type : sig
+         include BIT_FLAGS
+         val auditFailure : flags
+         val auditSuccess : flags
+         val error : flags
+         val information : flags
+         val warning : flags
+      end
+   end
+
    structure Module : sig
       type hmodule
       val getFileName : hmodule Option.t -> String.t