/* OCaml-Win32
 * win32_commondialog.c
 * Copyright (c) 2002-2004 by Harry Chomsky
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public
 * License as published by the Free Software Foundation; either
 * version 2 of the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Library General Public License for more details.
 *
 * You should have received a copy of the GNU Library General Public
 * License along with this library; if not, write to the Free
 * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#include "win32.h"

/********************************************************************/
/* User Interface: Windows User Experience: Windows Management: Windows User Interface: User Input: Common Dialog Box Library */

static DWORD choosecolor_options[] = {
    CC_ANYCOLOR,
    CC_FULLOPEN,
    CC_PREVENTFULLOPEN,
    CC_SHOWHELP,
    CC_SOLIDCOLOR 
};
Define_static_constants(choosecolor_options);

static UINT cc_hook_proc_impl(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
    CAMLparam0();
    window_data* wd;
    CHOOSECOLOR* cc;
    CAMLlocal3(wnd, msg, result);
    UINT uiresult;

    wd = make_window_data(hwnd);
    if (uMsg == WM_INITDIALOG) {
        cc = (CHOOSECOLOR*)lParam;
        wd->function = ((window_data*)cc->lCustData)->function;
    }
    if (Is_block(wd->function)) {
        wnd = alloc_handle(hwnd);
        msg = pack_message(uMsg, wParam, lParam);
        result = callback2(wd->function, wnd, msg);
        uiresult = Int32_val(result);
    } else
        uiresult = 0;
    if (uMsg == WM_NCDESTROY)
        remove_window_data(hwnd);
    CAMLreturn(uiresult);
}

static UINT CALLBACK cc_hook_proc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
    UINT result;

    leave_blocking_section();
    result = cc_hook_proc_impl(hwnd, uMsg, wParam, lParam);
    enter_blocking_section();
    return result;
}

static DWORD choosefont_options[] = {
    CF_APPLY,
    CF_BOTH,
    CF_EFFECTS,
    CF_FIXEDPITCHONLY,
    CF_FORCEFONTEXIST,
    CF_NOSCRIPTSEL,
    CF_NOSIMULATIONS,
    CF_NOVECTORFONTS,
    CF_NOVERTFONTS,
    CF_PRINTERFONTS,
    CF_SCALABLEONLY,
    CF_SCREENFONTS,
    CF_SCRIPTSONLY,
    CF_SELECTSCRIPT,
    CF_SHOWHELP,
    CF_TTONLY,
    CF_WYSIWYG
};
Define_static_constants(choosefont_options);

static UINT cf_hook_proc_impl(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
    CAMLparam0();
    window_data* wd;
    CHOOSEFONT* cf;
    CAMLlocal3(wnd, msg, result);
    UINT uiresult;

    wd = make_window_data(hwnd);
    if (uMsg == WM_INITDIALOG) {
        cf = (CHOOSEFONT*)lParam;
        wd->function = ((window_data*)cf->lCustData)->function;
    }
    if (Is_block(wd->function)) {
        wnd = alloc_handle(hwnd);
        msg = pack_message(uMsg, wParam, lParam);
        result = callback2(wd->function, wnd, msg);
        uiresult = Int32_val(result);
    } else
        uiresult = 0;
    if (uMsg == WM_NCDESTROY)
        remove_window_data(hwnd);
    CAMLreturn(uiresult);
}

static UINT CALLBACK cf_hook_proc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
    UINT result;

    leave_blocking_section();
    result = cf_hook_proc_impl(hwnd, uMsg, wParam, lParam);
    enter_blocking_section();
    return result;
}

static CHOOSEFONT* new_choosefont(value cf)
{
    CHOOSEFONT* c;
    value val, v;
    window_data* wd;

    c = malloc(sizeof(CHOOSEFONT));
    memset(c, 0, sizeof(CHOOSEFONT));
    c->lStructSize = sizeof(CHOOSEFONT);
    c->hwndOwner = Handle_val(Field(cf, 0));
    c->hDC = Handle_val(Field(cf, 1));
    c->lpLogFont = malloc(sizeof(LOGFONT));
    val = Field(cf, 2);
    if (Is_some(val)) {
        c->Flags |= CF_INITTOLOGFONTSTRUCT;
        logfont_val(Value_of(val), c->lpLogFont);
    } else
        memset(c->lpLogFont, 0, sizeof(LOGFONT));
    c->Flags |= flags_val(Field(cf, 3), choosefont_options);
    if (Bool_val(Field(cf, 4)))
        c->Flags |= CF_NOFACESEL;
    if (Bool_val(Field(cf, 5)))
        c->Flags |= CF_NOSTYLESEL;
    if (Bool_val(Field(cf, 6)))
        c->Flags |= CF_NOSIZESEL;
    c->rgbColors = color_val(Field(cf, 7));
    val = Field(cf, 8);
    if (Is_some(val)) {
        c->Flags |= CF_ENABLEHOOK;
        v = Value_of(val);
        if (Tag_val(v) == 0) {
            wd = new_window_data();
            wd->function = Field(v, 0);
            c->lCustData = (LPARAM)wd;
            c->lpfnHook = cf_hook_proc;
        } else
            c->lpfnHook = Pointer_val(Field(v, 0));
    }
    val = Field(cf, 9);
    if (Is_block(val)) {
        if (Tag_val(val) == 0) {
            c->Flags |= CF_ENABLETEMPLATEHANDLE;
            c->hInstance = Handle_val(Field(val, 0));
        } else {
            c->Flags |= CF_ENABLETEMPLATE;
            c->hInstance = Handle_val(Field(val, 0));
            c->lpTemplateName = new_atomname(Field(val, 1));
        }
    }
    val = Field(cf, 10);
    if (Is_some(val)) {
        c->Flags |= CF_USESTYLE;
        c->lpszStyle = malloc(256);
        strncpy(c->lpszStyle, String_val(Value_of(val)), 255);
        c->lpszStyle[255] = '\0';
    }
    val = Field(cf, 11);
    if (Is_some(val)) {
        c->Flags |= CF_LIMITSIZE;
        v = Value_of(val);
        c->nSizeMin = Int_val(Field(v, 0));
        c->nSizeMax = Int_val(Field(v, 1));
    }
    return c;
}

static void free_choosefont(CHOOSEFONT* c)
{
    window_data* wd;

    free(c->lpLogFont);
    wd = (window_data*)c->lCustData;
    if (wd != NULL)
        free_window_data(wd);
    if (c->lpTemplateName != NULL)
        free_atomname((LPTSTR)c->lpTemplateName);
    if (c->lpszStyle != NULL)
        free(c->lpszStyle);
    free(c);
}

static DWORD choosefont_types[] = {
    BOLD_FONTTYPE,
    ITALIC_FONTTYPE,
    PRINTER_FONTTYPE,
    REGULAR_FONTTYPE,
    SCREEN_FONTTYPE,
    SIMULATED_FONTTYPE
};
Define_static_constants(choosefont_types);

static value alloc_choosefontresult(CHOOSEFONT* c)
{
    CAMLparam0();
    CAMLlocal2(val, v);

    val = alloc_tuple(9);
    v = alloc_logfont(c->lpLogFont);
    Store_field(val, 0, v);
    Store_field(val, 1, Val_int(c->iPointSize));
    Store_field(val, 2, Val_bool((c->Flags & CF_NOFACESEL) != 0));
    Store_field(val, 3, Val_bool((c->Flags & CF_NOSTYLESEL) != 0));
    Store_field(val, 4, Val_bool((c->Flags & CF_NOSIZESEL) != 0));
    v = alloc_color(c->rgbColors);
    Store_field(val, 5, v);
    if (c->lpszStyle != NULL) {
        v = alloc_some(copy_string(c->lpszStyle));
    } else
        v = Val_none;
    Store_field(val, 6, v);
    v = Alloc_flags(c->nFontType, font_types);
    Store_field(val, 7, v);
    v = Alloc_flags(c->nFontType, choosefont_types);
    Store_field(val, 8, v);
    CAMLreturn(val);
}

static int get_ofnfilter_length(value filter)
{
    return string_length(Field(filter, 0)) + 1 +
        string_length(Field(filter, 1)) + 1 +
        1;
}

static void ofnfilter_val(value filter, char** bufp)
{
    strcpy(*bufp, String_val(Field(filter, 0)));
    *bufp += strlen(*bufp) + 1;
    strcpy(*bufp, String_val(Field(filter, 1)));
    *bufp += strlen(*bufp) + 1;
}

static value alloc_ofnfilter(char** bufp)
{
    CAMLparam0();
    CAMLlocal2(val, v);

    val = alloc_tuple(2);
    v = copy_string(*bufp);
    Store_field(val, 0, v);
    *bufp += strlen(*bufp) + 1;
    v = copy_string(*bufp);
    Store_field(val, 1, v);
    *bufp += strlen(*bufp) + 1;
    CAMLreturn(val);
}

static DWORD openfilename_options[] = {
    OFN_ALLOWMULTISELECT,
    OFN_CREATEPROMPT,
    OFN_ENABLESIZING,
    OFN_EXPLORER,
    OFN_FILEMUSTEXIST,
    OFN_HIDEREADONLY,
    OFN_LONGNAMES,
    OFN_NOCHANGEDIR,
    OFN_NODEREFERENCELINKS,
    OFN_NOLONGNAMES,
    OFN_NONETWORKBUTTON,
    OFN_NOTESTFILECREATE,
    OFN_NOVALIDATE,
    OFN_OVERWRITEPROMPT,
    OFN_PATHMUSTEXIST,
    OFN_SHAREAWARE,
    OFN_SHOWHELP
};
Define_static_constants(openfilename_options);

static UINT ofn_hook_proc_impl(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
    CAMLparam0();
    window_data* wd;
    OPENFILENAME* ofn;
    CAMLlocal3(wnd, msg, result);
    UINT uiresult;

    wd = make_window_data(hwnd);
    if (uMsg == WM_INITDIALOG) {
        ofn = (OPENFILENAME*)lParam;
        wd->function = ((window_data*)ofn->lCustData)->function;
    }
    if (Is_block(wd->function)) {
        wnd = alloc_handle(hwnd);
        msg = pack_message(uMsg, wParam, lParam);
        result = callback2(wd->function, wnd, msg);
        uiresult = Int32_val(result);
    } else
        uiresult = 0;
    if (uMsg == WM_NCDESTROY)
        remove_window_data(hwnd);
    CAMLreturn(uiresult);
}

static UINT CALLBACK ofn_hook_proc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
    UINT result;

    leave_blocking_section();
    result = ofn_hook_proc_impl(hwnd, uMsg, wParam, lParam);
    enter_blocking_section();
    return result;
}

static OPENFILENAME* new_openfilename(value ofn)
{
    OPENFILENAME* o;
    value val, v;
    int len;
    char* p;
    window_data* wd;

    o = malloc(sizeof(OPENFILENAME));
    memset(o, 0, sizeof(OPENFILENAME));
    o->lStructSize = sizeof(OPENFILENAME);
    o->hwndOwner = Handle_val(Field(ofn, 0));
    val = Field(ofn, 1);
    if (Is_block(val)) {
        if (Tag_val(val) == 0) {
            o->Flags |= OFN_ENABLETEMPLATEHANDLE;
            o->hInstance = Handle_val(Field(val, 0));
        } else {
            o->Flags |= OFN_ENABLETEMPLATE;
            o->hInstance = Handle_val(Field(val, 0));
            o->lpTemplateName = new_atomname(Field(val, 1));
        }
    }
    val = Field(ofn, 2);
    if (Is_some(val)) {
        len = 0;
        for (v = Value_of(val); !Is_nil(v); v = Tail(v))
            len += get_ofnfilter_length(Head(v));
        ++len;
        p = malloc(len);
        o->lpstrFilter = p;
        for (v = Value_of(val); !Is_nil(v); v = Tail(v))
            ofnfilter_val(Head(v), &p);
        *p = '\0';
    } else
        o->lpstrFilter = NULL;
    val = Field(ofn, 3);
    if (Is_some(val)) {
        v = Value_of(val);
        len = get_ofnfilter_length(v) + 256;
        p = malloc(len);
        o->lpstrCustomFilter = p;
        ofnfilter_val(v, &p);
        o->nMaxCustFilter = len;
    } else
        o->lpstrCustomFilter = NULL;
    o->nFilterIndex = Int_val(Field(ofn, 4));
    o->lpstrFile = malloc(_MAX_PATH+1);
    strncpy(o->lpstrFile, String_val(Field(ofn, 5)), _MAX_PATH);
    o->lpstrFile[_MAX_PATH] = '\0';
    o->nMaxFile = _MAX_PATH+1;
    o->lpstrFileTitle = malloc(_MAX_PATH+1);
    o->lpstrFileTitle[0] = '\0';
    o->nMaxFileTitle = _MAX_PATH+1;
    o->lpstrInitialDir = new_stringoption(Field(ofn, 6));
    o->lpstrTitle = new_stringoption(Field(ofn, 7));
    o->Flags |= flags_val(Field(ofn, 8), openfilename_options);
    if (Bool_val(Field(ofn, 9)))
        o->Flags |= OFN_READONLY;
    o->lpstrDefExt = new_stringoption(Field(ofn, 10));
    val = Field(ofn, 11);
    if (Is_some(val)) {
        o->Flags |= OFN_ENABLEHOOK;
        v = Value_of(val);
        if (Tag_val(v) == 0) {
            wd = new_window_data();
            wd->function = Field(v, 0);
            o->lCustData = (LPARAM)wd;
            o->lpfnHook = ofn_hook_proc;
        } else
            o->lpfnHook = Pointer_val(Field(v, 0));
    }
    return o;
}

static void free_openfilename(OPENFILENAME* o)
{
    window_data* wd;

    if (o->lpTemplateName != NULL)
        free_atomname((LPTSTR)o->lpTemplateName);
    if (o->lpstrFilter != NULL)
        free((char*)o->lpstrFilter);
    if (o->lpstrCustomFilter != NULL)
        free(o->lpstrCustomFilter);
    free(o->lpstrFile);
    free(o->lpstrFileTitle);
    free_stringoption((char*)o->lpstrInitialDir);
    free_stringoption((char*)o->lpstrTitle);
    free_stringoption((char*)o->lpstrDefExt);
    wd = (window_data*)o->lCustData;
    if (wd != NULL)
        free_window_data(wd);
    free(o);
}

static value alloc_string_from_list(char** bufp, BOOL explorer)
{
    CAMLparam0();
    CAMLlocal1(val);
    char* p;

    if (explorer) {
        val = copy_string(*bufp);
        *bufp += strlen(*bufp) + 1;
    } else {
        p = strchr(*bufp, ' ');
        if (p == NULL) {
            val = copy_string(*bufp);
            *bufp += strlen(*bufp);
        } else {
            val = alloc_string(p - *bufp);
            memcpy(String_val(val), *bufp, p - *bufp);
            *bufp = p + 1;
        }
    }
    CAMLreturn(val);
}

static value alloc_stringlist(char** bufp, BOOL explorer)
{
    CAMLparam0();
    CAMLlocal3(val, hd, tl);

    if (**bufp == '\0')
        val = Val_nil;
    else {
        hd = alloc_string_from_list(bufp, explorer);
        tl = alloc_stringlist(bufp, explorer);
        val = alloc_cons(hd, tl);
    }
    CAMLreturn(val);
}

static value alloc_openfilenameresult(OPENFILENAME* o)
{
    CAMLparam0();
    CAMLlocal5(val, v, v1, v2, vv);
    char* p;

    val = alloc_tuple(10);
    if (o->lpstrCustomFilter != NULL) {
        p = o->lpstrCustomFilter;
        v = alloc_some(alloc_ofnfilter(&p));
    } else
        v = Val_none;
    Store_field(val, 0, v);
    Store_field(val, 1, Val_int(o->nFilterIndex));
    v = copy_string(o->lpstrFile);
    Store_field(val, 2, v);
    v = Val_none;
    if (o->Flags & OFN_ALLOWMULTISELECT) {
        p = o->lpstrFile;
        v1 = alloc_string_from_list(&p, (o->Flags & OFN_EXPLORER) != 0);
        v2 = alloc_stringlist(&p, (o->Flags & OFN_EXPLORER) != 0);
        if (!Is_nil(v2)) {
            vv = alloc_tuple(2);
            Store_field(vv, 0, v1);
            Store_field(vv, 1, v2);
            v = alloc_some(vv);
        }
    }
    Store_field(val, 3, v);
    v = copy_string(o->lpstrFileTitle);
    Store_field(val, 4, v);
    Store_field(val, 5, Val_bool((o->Flags & OFN_EXTENSIONDIFFERENT) != 0));
    Store_field(val, 6, Val_bool((o->Flags & OFN_NOREADONLYRETURN) != 0));
    Store_field(val, 7, Val_bool((o->Flags & OFN_READONLY) != 0));
    Store_field(val, 8, Val_int(o->nFileOffset));
    Store_field(val, 9, Val_int(o->nFileExtension));
    CAMLreturn(val);
}

static value* common_dialog_error_exception = NULL;

static void raise_common_dialog_error(DWORD error)
{
    if (common_dialog_error_exception == NULL) {
        common_dialog_error_exception =
            caml_named_value("win32 common dialog error");
    }
    raise_with_arg(*common_dialog_error_exception, Val_int((int)error));
}

static BOOL check_common_dialog_result(BOOL result)
{
    DWORD error;

    if (!result) {
        error = CommDlgExtendedError();
        if (error != 0)
            raise_common_dialog_error(error);
    }
    return result;
}

CAMLprim value choose_color(value cc)
{
    CAMLparam1(cc);
    CHOOSECOLOR c;
    COLORREF cust_colors[16];
    CAMLlocal3(val, v, vv);
    int i;
    window_data* wd;
    BOOL result;

    memset(&c, 0, sizeof(CHOOSECOLOR));
    c.lStructSize = sizeof(CHOOSECOLOR);
    c.hwndOwner = Handle_val(Field(cc, 0));
    val = Field(cc, 1);
    if (Is_block(val)) {
        if (Tag_val(val) == 0) {
            c.Flags |= CC_ENABLETEMPLATEHANDLE;
            c.hInstance = Handle_val(Field(val, 0));
        } else {
            c.Flags |= CC_ENABLETEMPLATE;
            c.hInstance = Handle_val(Field(val, 0));
            c.lpTemplateName = new_atomname(Field(val, 1));
        }
    }
    val = Field(cc, 2);
    if (Is_some(val)) {
        c.Flags |= CC_RGBINIT;
        c.rgbResult = color_val(Value_of(val));
    }
    c.lpCustColors = cust_colors;
    val = Field(cc, 3);
    if (Is_some(val)) {
        v = Value_of(val);
        for (i = 0; i < 16; ++i)
            cust_colors[i] = color_val(Field(v, i));
    } else {
        for (i = 0; i < 16; ++i)
            cust_colors[i] = RGB(255,255,255);
    }
    c.Flags |= flags_val(Field(cc, 4), choosecolor_options);
    wd = NULL;
    val = Field(cc, 5);
    if (Is_some(val)) {
        c.Flags |= CC_ENABLEHOOK;
        v = Value_of(val);
        if (Tag_val(v) == 0) {
            wd = new_window_data();
            wd->function = Field(v, 0);
            c.lCustData = (LPARAM)wd;
            c.lpfnHook = cc_hook_proc;
        } else
            c.lpfnHook = Pointer_val(Field(v, 0));
    }
    enter_blocking_section();
    result = ChooseColor(&c);
    leave_blocking_section();
    if (c.lpTemplateName != NULL)
        free_atomname((LPTSTR)c.lpTemplateName);
    if (wd != NULL)
        free_window_data(wd);
    if (check_common_dialog_result(result)) {
        val = Field(cc, 3);
        if (Is_some(val)) {
            v = Value_of(val);
            for (i = 0; i < 16; ++i) {
                vv = alloc_color(cust_colors[i]);
                Store_field(v, i, vv);
            }
        }
        val = alloc_some(alloc_color(c.rgbResult));
    } else
        val = Val_none;
    CAMLreturn(val);
}

CAMLprim value choose_font(value cf)
{
    CAMLparam1(cf);
    CHOOSEFONT* c;
    BOOL result;
    CAMLlocal1(val);

    c = new_choosefont(cf);
    enter_blocking_section();
    result = ChooseFont(c);
    leave_blocking_section();
    if (result) {
        val = alloc_some(alloc_choosefontresult(c));
        free_choosefont(c);
    } else {
        free_choosefont(c);
        check_common_dialog_result(result);
        val = Val_none;
    }
    CAMLreturn(val);
}

CAMLprim value get_file_title(value name)
{
    CAMLparam1(name);
    WORD len;
    char* buf;
    CAMLlocal1(val);

    len = GetFileTitle(String_val(name), NULL, 0);
    if (len < 0)
        raise_win32_error(0);
    buf = malloc(len);
    len = GetFileTitle(String_val(name), buf, len);
    if (len != 0) {
        free(buf);
        raise_win32_error(0);
    }
    val = copy_string(buf);
    free(buf);
    CAMLreturn(val);
}

CAMLprim value get_open_file_name(value ofn)
{
    CAMLparam1(ofn);
    OPENFILENAME* o;
    BOOL result;
    CAMLlocal1(val);

    o = new_openfilename(ofn);
    enter_blocking_section();
    result = GetOpenFileName(o);
    leave_blocking_section();
    if (result) {
        val = alloc_some(alloc_openfilenameresult(o));
        free_openfilename(o);
    } else {
        free_openfilename(o);
        check_common_dialog_result(result);
        val = Val_none;
    }
    CAMLreturn(val);
}

CAMLprim value get_save_file_name(value ofn)
{
    CAMLparam1(ofn);
    OPENFILENAME* o;
    BOOL result;
    CAMLlocal1(val);

    o = new_openfilename(ofn);
    enter_blocking_section();
    result = GetSaveFileName(o);
    leave_blocking_section();
    if (result) {
        val = alloc_some(alloc_openfilenameresult(o));
        free_openfilename(o);
    } else {
        free_openfilename(o);
        check_common_dialog_result(result);
        val = Val_none;
    }
    CAMLreturn(val);
}

/* Messages */

CAMLprim value issue_cdm_getfilepath(value sender)
{
    CAMLparam1(sender);
    char path[_MAX_PATH+1];
    CAMLlocal3(contents, result, string);
    int res;

    contents = pack_message(CDM_GETFILEPATH, sizeof(path), (LPARAM)path);
    result = callback(sender, contents);
    res = Int32_val(result);
    if (res < 0 || res > sizeof(path))
        raise_win32_error(0);
    string = copy_string(path);
    CAMLreturn(string);
}

CAMLprim value issue_cdm_getfolderpath(value sender)
{
    CAMLparam1(sender);
    char path[_MAX_PATH+1];
    CAMLlocal3(contents, result, string);
    int res;

    contents = pack_message(CDM_GETFOLDERPATH, sizeof(path), (LPARAM)path);
    result = callback(sender, contents);
    res = Int32_val(result);
    if (res < 0 || res > sizeof(path))
        raise_win32_error(0);
    string = copy_string(path);
    CAMLreturn(string);
}

CAMLprim value issue_cdm_getspec(value sender)
{
    CAMLparam1(sender);
    char spec[_MAX_PATH+1];
    CAMLlocal3(contents, result, string);
    int res;

    contents = pack_message(CDM_GETSPEC, sizeof(spec), (LPARAM)spec);
    result = callback(sender, contents);
    res = Int32_val(result);
    if (res < 0 || res > sizeof(spec))
        raise_win32_error(0);
    string = copy_string(spec);
    CAMLreturn(string);
}

CAMLprim value pack_cdm_hidecontrol(value id)
{
    return pack_message(CDM_HIDECONTROL, Int_val(id), 0);
}

CAMLprim value issue_cdm_setcontroltext(value sender, value id, value text)
{
    CAMLparam3(sender, id, text);
    char* s;
    CAMLlocal1(contents);

    s = new_string(text);
    contents = pack_message(CDM_SETCONTROLTEXT, Int_val(id), (LPARAM)s);
    callback(sender, contents);
    free_string(s);
    CAMLreturn(Val_unit);
}

CAMLprim value issue_cdm_setdefext(value sender, value ext)
{
    CAMLparam2(sender, ext);
    char* s;
    CAMLlocal1(contents);

    s = new_string(ext);
    contents = pack_message(CDM_SETDEFEXT, 0, (LPARAM)s);
    callback(sender, contents);
    free_string(s);
    CAMLreturn(Val_unit);
}

CAMLprim value pack_setrgb(value color)
{
    UINT id;

    id = RegisterWindowMessage(SETRGBSTRING);
    return pack_message(id, 0, color_val(color));
}

CAMLprim value issue_wm_choosefont_getlogfont(value sender)
{
    CAMLparam1(sender);
    LOGFONT lf;
    CAMLlocal2(contents, val);

    contents = pack_message(WM_CHOOSEFONT_GETLOGFONT, 0, (LPARAM)&lf);
    callback(sender, contents);
    val = alloc_logfont(&lf);
    CAMLreturn(val);
}

CAMLprim value issue_wm_choosefont_setflags(value sender, value cf)
{
    CAMLparam2(sender, cf);
    CHOOSEFONT* c;
    CAMLlocal1(contents);

    c = new_choosefont(cf);
    contents = pack_message(WM_CHOOSEFONT_SETFLAGS, 0, (LPARAM)c);
    callback(sender, contents);
    free_choosefont(c);
    CAMLreturn(Val_unit);
}

CAMLprim value issue_wm_choosefont_setlogfont(value sender, value lf)
{
    CAMLparam1(sender);
    LOGFONT l;
    CAMLlocal1(contents);

    logfont_val(lf, &l);
    contents = pack_message(WM_CHOOSEFONT_SETLOGFONT, 0, (LPARAM)&l);
    callback(sender, contents);
    CAMLreturn(Val_unit);
}

/* Notifications */

CAMLprim value deliver_colorok(value handler, value wnd, value msg)
{
    CAMLparam3(handler, wnd, msg);
    CHOOSECOLOR* cc;
    CAMLlocal2(color, result);

    cc = (CHOOSECOLOR*)Lparam(msg);
    color = alloc_color(cc->rgbResult);
    result = callback3(handler, wnd, msg, color);
    CAMLreturn(result);
}

CAMLprim value deliver_fileok(value handler, value wnd, value msg)
{
    CAMLparam3(handler, wnd, msg);
    OPENFILENAME* ofn;
    CAMLlocal2(ofnr, result);

    ofn = (OPENFILENAME*)Lparam(msg);
    ofnr = alloc_openfilenameresult(ofn);
    result = callback3(handler, wnd, msg, ofnr);
    CAMLreturn(result);
}

CAMLprim value deliver_helpmsg(value handler, value wnd, value msg)
{
    CAMLparam3(handler, wnd, msg);
    CAMLlocal2(dlg, result);

    dlg = alloc_handle((HWND)Wparam(msg));
    result = callback3(handler, wnd, msg, dlg);
    CAMLreturn(result);
}

static DWORD lbselch_events[] = {
    CD_LBSELCHANGE,
    CD_LBSELADD,
    CD_LBSELSUB,
    CD_LBSELNOITEMS
};
Define_static_constants(lbselch_events);

CAMLprim value deliver_lbselch(value handler, value wnd, value msg)
{
    CAMLparam3(handler, wnd, msg);
    CAMLlocalN(args, 5);
    CAMLlocal1(result);

    args[0] = wnd;
    args[1] = msg;
    args[2] = Val_int(Wparam(msg));
    args[3] = Val_int(LOWORD(Lparam(msg)));
    args[4] = Val_constant(HIWORD(Lparam(msg)), lbselch_events);
    result = callbackN(handler, 5, args);
    CAMLreturn(result);
}
