(* OCaml-Win32
 * win32_commondialog.ml
 * 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.
 *)

open Win32_core

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

type common_dialog_template =
    Cdt_none
  | Cdt_handle of handle
  | Cdt_name of hinstance * atom_name

type choosecolor_option =
    CC_ANYCOLOR
  | CC_FULLOPEN
  | CC_PREVENTFULLOPEN
  | CC_SHOWHELP
  | CC_SOLIDCOLOR 
type choosecolor = {
    cc_owner : hwnd;
    cc_template : common_dialog_template;
    cc_color : color option;
    cc_cust_colors : color array option;
    cc_flags : choosecolor_option list;
    cc_hook : window_proc option }
let default_choosecolor = {
    cc_owner = null_hwnd;
    cc_template = Cdt_none;
    cc_color = None;
    cc_cust_colors = None;
    cc_flags = [];
    cc_hook = None }

type choosefont_option =
    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
type choosefont = {
    cf_owner : hwnd;
    cf_hdc : hdc;
    cf_logfont : logfont option;
    cf_flags : choosefont_option list;
    cf_nofacesel : bool;
    cf_nostylesel : bool;
    cf_nosizesel : bool;
    cf_color : color;
    cf_hook : window_proc option;
    cf_template : common_dialog_template;
    cf_style : string option;
    cf_size_limits : (int * int) option }
let default_choosefont = {
    cf_owner = null_hwnd;
    cf_hdc = null_handle;
    cf_logfont = None;
    cf_flags = [];
    cf_nofacesel = false;
    cf_nostylesel = false;
    cf_nosizesel = false;
    cf_color = Clr_rgb { red = 0; green = 0; blue = 0 };
    cf_hook = None;
    cf_template = Cdt_none;
    cf_style = None;
    cf_size_limits = None }
type choosefont_type =
    BOLD_FONTTYPE
  | ITALIC_FONTTYPE
  | PRINTER_FONTTYPE
  | REGULAR_FONTTYPE
  | SCREEN_FONTTYPE
  | SIMULATED_FONTTYPE
type choosefont_result = {
    cfr_logfont : logfont;
    cfr_point_size : int;
    cfr_nofacesel : bool;
    cfr_nostylesel : bool;
    cfr_nosizesel : bool;
    cfr_color : color;
    cfr_style : string option;
    cfr_type : font_type list;
    cfr_choosefont_type : choosefont_type list }

let update_choosefont ~cf ~cfr =
    { cf with
        cf_logfont = Some cfr.cfr_logfont;
        cf_nofacesel = cfr.cfr_nofacesel;
        cf_nostylesel = cfr.cfr_nostylesel;
        cf_nosizesel = cfr.cfr_nosizesel;
        cf_color = cfr.cfr_color;
        cf_style = cfr.cfr_style }

type openfilename_filter = string * string

type openfilename_option =
    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
type openfilename = {
    ofn_owner : hwnd;
    ofn_template : common_dialog_template;
    ofn_filter : openfilename_filter list option;
    ofn_custom_filter : openfilename_filter option;
    ofn_filter_index : int;
    ofn_file : string;
    ofn_initial_dir : string option;
    ofn_title : string option;
    ofn_flags : openfilename_option list;
    ofn_readonly : bool;
    ofn_def_ext : string option;
    ofn_hook : window_proc option }
let default_openfilename = {
    ofn_owner = null_hwnd;
    ofn_template = Cdt_none;
    ofn_filter = None;
    ofn_custom_filter = None;
    ofn_filter_index = 0;
    ofn_file = "";
    ofn_initial_dir = None;
    ofn_title = None;
    ofn_flags = [];
    ofn_readonly = false;
    ofn_def_ext = None;
    ofn_hook = None }

type openfilename_result = {
    ofnr_custom_filter : openfilename_filter option;
    ofnr_filter_index : int;
    ofnr_file : string;
    ofnr_multi_file : (string * string list) option;
    ofnr_file_title : string;
    ofnr_extensiondifferent : bool;
    ofnr_noreadonlyreturn : bool;
    ofnr_readonly : bool;
    ofnr_file_offset : int;
    ofnr_file_extension : int }

let update_openfilename ~ofn ~ofnr =
    { ofn with
        ofn_custom_filter = ofnr.ofnr_custom_filter;
        ofn_filter_index = ofnr.ofnr_filter_index;
        ofn_file = ofnr.ofnr_file;
        ofn_readonly = ofnr.ofnr_readonly }

type common_dialog_error_code = int
exception Common_dialog_error of common_dialog_error_code
let _ = Callback.register_exception "win32 common dialog error" (Common_dialog_error 0)

external choose_color : cc:choosecolor -> color option = "choose_color"

external choose_font : cf:choosefont -> choosefont_result option = "choose_font"

external get_file_title : name:string -> string = "get_file_title"

external get_open_file_name : ofn:openfilename -> openfilename_result option = "get_open_file_name"

external get_save_file_name : ofn:openfilename -> openfilename_result option = "get_save_file_name"

(* Messages *)

let cdm_first = wm_user + 100

let cdm_getfilepath = cdm_first + 0x0001
external issue_cdm_getfilepath : sender:message_sender -> string = "issue_cdm_getfilepath"

let cdm_getfolderidlist = cdm_first + 0x0003
(* ... *)

let cdm_getfolderpath = cdm_first + 0x0002
external issue_cdm_getfolderpath : sender:message_sender -> string = "issue_cdm_getfolderpath"

let cdm_getspec = cdm_first + 0x0000
external issue_cdm_getspec : sender:message_sender -> string = "issue_cdm_getspec"

let cdm_hidecontrol = cdm_first + 0x0005
external pack_cdm_hidecontrol : id:int -> message_contents = "pack_cdm_hidecontrol"
let unpack_cdm_hidecontrol = ignore
let issue_cdm_hidecontrol ~sender ~id = unpack_cdm_hidecontrol (sender ~msg:(pack_cdm_hidecontrol ~id))

let cdm_setcontroltext = cdm_first + 0x0004
external issue_cdm_setcontroltext : sender:message_sender -> id:int -> text:string -> unit = "issue_cdm_setcontroltext"

let cdm_setdefext = cdm_first + 0x0006
external issue_cdm_setdefext : sender:message_sender -> ext:string -> unit = "issue_cdm_setdefext"

let setrgbstring = "commdlg_SetRGBColor"
external pack_setrgb : color:color -> message_contents = "pack_setrgb"
let unpack_setrgb = ignore
let issue_setrgb ~sender ~color = unpack_setrgb (sender ~msg:(pack_setrgb ~color))

let wm_choosefont_getlogfont = wm_user + 1
external issue_wm_choosefont_getlogfont : sender:message_sender -> logfont = "issue_wm_choosefont_getlogfont"

let wm_choosefont_setflags = wm_user + 102
external issue_wm_choosefont_setflags : sender:message_sender -> cf:choosefont -> unit = "issue_wm_choosefont_setflags"

let wm_choosefont_setlogfont = wm_user + 101
external issue_wm_choosefont_setlogfont : sender:message_sender -> lf:logfont -> unit = "issue_wm_choosefont_setlogfont"

(* Notifications *)

let colorokstring = "commdlg_ColorOK"
type colorok_handler =
    wnd:hwnd ->
    msg:message_contents ->
    color:color ->
    unit message_handler_result
external deliver_colorok :
    handler:colorok_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    unit message_handler_result = "deliver_colorok"

let fileokstring = "commdlg_FileNameOK"
type fileok_handler =
    wnd:hwnd ->
    msg:message_contents ->
    ofnr:openfilename_result ->
    unit message_handler_result
external deliver_fileok :
    handler:fileok_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    unit message_handler_result = "deliver_fileok"

let helpmsgstring = "commdlg_help"
type helpmsg_handler =
    wnd:hwnd ->
    msg:message_contents ->
    dlg:hwnd ->
    unit message_handler_result
external deliver_helpmsg :
    handler:helpmsg_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    unit message_handler_result = "deliver_helpmsg"

let lbselchstring = "commdlg_LBSelChangedNotify"
type lbselch_event =
    CD_LBSELCHANGE
  | CD_LBSELADD
  | CD_LBSELSUB
  | CD_LBSELNOITEMS
type lbselch_handler =
    wnd:hwnd ->
    msg:message_contents ->
    id:int ->
    item:int ->
    event:lbselch_event ->
    unit message_handler_result
external deliver_lbselch :
    handler:lbselch_handler ->
    wnd:hwnd ->
    msg:message_contents ->
    unit message_handler_result = "deliver_lbselch"

let sharevistring = "commdlg_ShareViolation"
(* ... explicit dialog return -- but id not statically known... *)
