#include <stdio.h>
#include <windows.h>
#include <caml/memory.h>
#include <caml/mlvalues.h>
#define Is_nil(v) ((v) == Val_int(0))
#define Head(v) (Field((v), 0))
#define Tail(v) (Field((v), 1))
#define Declare_constants(name)
extern DWORD name[];
extern int num_##name
#define Define_constants(name)
int num_##name = sizeof(name) / sizeof(DWORD)
#define Constant_val(val, constants) (constants[Int_val(val)])
#define Handle_val(v) (*((HANDLE*)(v)))
value alloc_handle(HANDLE h);
value val_constant_with_count(DWORD constant, int num_constants, DWORD* constants);
#define Val_constant(constant, constants)
(val_constant_with_count((constant), num_##constants, constants))
Declare_constants(standard_control_ids);
DWORD standard_control_ids[] = {
IDABORT,
IDCANCEL,
IDCLOSE,
IDHELP,
IDIGNORE,
IDNO,
IDOK,
IDRETRY,
IDYES
};
Define_constants(standard_control_ids);
DWORD message_box_options[] = {
MB_ABORTRETRYIGNORE,
MB_APPLMODAL,
MB_DEFAULT_DESKTOP_ONLY,
MB_DEFBUTTON1,
MB_DEFBUTTON2,
MB_DEFBUTTON3,
MB_DEFBUTTON4,
MB_HELP,
MB_ICONASTERISK,
MB_ICONERROR,
MB_ICONEXCLAMATION,
MB_ICONHAND,
MB_ICONINFORMATION,
MB_ICONQUESTION,
MB_ICONSTOP,
MB_ICONWARNING,
MB_OK,
MB_OKCANCEL,
MB_RETRYCANCEL,
MB_RIGHT,
MB_RTLREADING,
MB_SETFOREGROUND,
MB_SYSTEMMODAL,
MB_TASKMODAL,
MB_TOPMOST,
MB_YESNO,
MB_YESNOCANCEL
};
value val_constant_with_count(DWORD constant, int num_constants, DWORD* constants)
{
int i;
for (i = 0; i < num_constants; ++i)
if (constants[i] == constant)
return Val_int(i);
failwith("Invalid constant");
return Val_int(0);
}
CAMLprim value get_null_hwnd(value unit)
{
return alloc_handle(NULL);
}
value alloc_handle(HANDLE h)
{
value val;
val = alloc_small(sizeof(HANDLE) / sizeof(value), Abstract_tag);
Handle_val(val) = h;
return val;
}
DWORD flags_val(value list, DWORD* constants)
{
int result;
result = 0;
for (; !Is_nil(list); list = Tail(list))
result |= Constant_val(Head(list), constants);
return result;
}
char* new_string(value v)
{
return strdup(String_val(v));
}
void free_string(char* s)
{
free(s);
}
static value* win32_error_exception = NULL;
void raise_win32_error(DWORD error)
{
if (win32_error_exception == NULL)
win32_error_exception = caml_named_value("win32 error");
raise_with_arg(*win32_error_exception, Val_int((int)error));
}
void raise_last_error(void)
{
raise_win32_error(GetLastError());
}
CAMLprim value message_box(value wnd, value text, value caption, value type)
{
CAMLparam4(wnd, text, caption, type);
HWND hwnd;
char* txt;
char* capt;
UINT typ;
int result;
hwnd = Handle_val(wnd);
txt = new_string(text);
capt = new_string(caption);
typ = flags_val(type, message_box_options);
enter_blocking_section();
result = MessageBox(hwnd, txt, capt, typ);
leave_blocking_section();
free_string(txt);
free_string(capt);
if (result == 0)
raise_last_error();
CAMLreturn(Val_constant(result, standard_control_ids));
} |