(***********************************************************************)
(*                                                                     *)
(*                 MLTk, Tcl/Tk interface of OCaml                     *)
(*                                                                     *)
(*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
(*               projet Cristal, INRIA Rocquencourt                    *)
(*            Jacques Garrigue, Kyoto University RIMS                  *)
(*                                                                     *)
(*  Copyright 2002 Institut National de Recherche en Informatique et   *)
(*  en Automatique and Kyoto University.  All rights reserved.         *)
(*  This file is distributed under the terms of the GNU Library        *)
(*  General Public License, with the special exception on linking      *)
(*  described in file LICENSE found in the OCaml source tree.          *)
(*                                                                     *)
(***********************************************************************)
module Widget : sig
  type widget = Widget.any Widget.widget
    (* widget is an abstract type *)

  val default_toplevel : widget
    (* [default_toplevel] is "." in Tk, the toplevel widget that is
       always existing during a Tk session. Destroying [default_toplevel]
       ends the main loop
     *)

  val atom : parent: widget -> name: string -> widget
    (* [atom parent name] returns the widget [parent.name]. The widget is
       not created. Only its name is returned. In a given parent, there may
       only exist one children for a given name.
       This function should only be used to check the existence of a widget
       with a known name. It doesn't add the widget to the internal tables
       of CamlTk.
     *)

  val name : widget -> string
    (* [name w] returns the name (tk "path") of a widget *)

  (*--*)
  (* The following functions are used internally.
     There is normally no need for them in users programs
   *)

  val known_class : widget -> string
    (* [known_class w] returns the class of a widget (e.g. toplevel, frame),
       as known by the CamlTk interface.
       Not equivalent to "winfo w" in Tk.
     *)

  val dummy : widget
    (* [dummy] is a widget used as context when we don't have any.
       It is *not* a real widget.
     *)

  val new_atom : parent: widget -> ?name: string -> string -> widget
      (* incompatible with the classic camltk *)

  val get_atom : string -> widget
    (* [get_atom path] returns the widget with Tk path [path] *)

  val remove : widget -> unit
    (* [remove w] removes widget from the internal tables *)

  (* Subtypes tables *)
  val widget_any_table : string list
  val widget_button_table : string list
  val widget_canvas_table : string list
  val widget_checkbutton_table : string list
  val widget_entry_table : string list
  val widget_frame_table : string list
  val widget_label_table : string list
  val widget_listbox_table : string list
  val widget_menu_table : string list
  val widget_menubutton_table : string list
  val widget_message_table : string list
  val widget_radiobutton_table : string list
  val widget_scale_table : string list
  val widget_scrollbar_table : string list
  val widget_text_table : string list
  val widget_toplevel_table : string list

  val chk_sub : string -> 'a list -> 'a -> unit
  val check_class : widget -> string list -> unit
        (* Widget subtyping *)

  exception IllegalWidgetType of string
        (* Raised when widget command applied illegally*)

  (* this function is not used, but introduced for the compatibility
     with labltk. useless for camltk users *)
  val coe : 'a Widget.widget -> Widget.any Widget.widget
end

module Protocol : sig
  open Widget

  (* Lower level interface *)
  exception TkError of string
        (* Raised by the communication functions *)

  val debug : bool ref
        (* When set to true, displays approximation of intermediate Tcl code *)

  type tkArgs =
      TkToken of string
    | TkTokenList of tkArgs list          (* to be expanded *)
    | TkQuote of tkArgs                   (* mapped to Tcl list *)


  (* Misc *)
  external splitlist : string -> string list
          = "camltk_splitlist"

  val add_destroy_hook : (widget -> unit) -> unit


  (* Opening, closing, and mainloop *)
  val default_display : unit -> string

  val opentk : unit -> widget
    (* The basic initialization function. [opentk ()] parses automatically
       the command line options and use the tk related options in them
       such as "-display localhost:0" to initialize Tk applications.
       Consult wish manpage about the supported options. *)

  val keywords : (string * Arg.spec * string) list
    (* Command line parsing specification for Arg.parse, which contains
       the standard Tcl/Tk command line options such as "-display" and "-name".
       These Tk command line options are used by opentk *)

  val opentk_with_args : string list -> widget
    (* [opentk_with_args argv] invokes [opentk] with the tk related
       command line options given by [argv] to the executable program. *)

  val openTk : ?display:string -> ?clas:string -> unit -> widget
      (* [openTk ~display:display ~clas:clas ()] is equivalent to
         [opentk ["-display"; display; "-name"; clas]] *)

  (* Legacy opentk functions *)
  val openTkClass: string -> widget
      (* [openTkClass class] is equivalent to [opentk ["-name"; class]] *)
  val openTkDisplayClass: string -> string -> widget
      (* [openTkDisplayClass disp class] is equivalent to
         [opentk ["-display"; disp; "-name"; class]] *)

  val closeTk : unit -> unit
  val finalizeTk : unit -> unit
      (* Finalize tcl/tk before exiting. This function will be automatically
         called when you call [Pervasives.exit ()] *)

  val mainLoop : unit -> unit


  (* Direct evaluation of tcl code *)
  val tkEval : tkArgs array -> string

  val tkCommand : tkArgs array -> unit

  (* Returning a value from a Tcl callback *)
  val tkreturn: string -> unit


  (* Callbacks: this is private *)

  type cbid = Protocol.cbid

  type callback_buffer = string list
        (* Buffer for reading callback arguments *)

  val callback_naming_table : (cbid, callback_buffer -> unit) Hashtbl.t
  (* CAMLTK val callback_memo_table : (widget, cbid) Hashtbl.t *)
  val callback_memo_table : (widget, cbid) Hashtbl.t
        (* Exported for debug purposes only. Don't use them unless you
           know what you are doing *)
  val new_function_id : unit -> cbid
  val string_of_cbid : cbid -> string
  val register_callback : widget -> callback:(callback_buffer -> unit) -> string
        (* Callback support *)
  val clear_callback : cbid -> unit
        (* Remove a given callback from the table *)
  val remove_callbacks : widget -> unit
        (* Clean up callbacks associated to widget. Must be used only when
           the Destroy event is bind by the user and masks the default
           Destroy event binding *)

  val cTKtoCAMLwidget : string -> widget
  val cCAMLtoTKwidget : string list -> widget -> tkArgs

  val register : string -> callback:(callback_buffer -> unit) -> unit

  (*-*)
  val prerr_cbid : cbid -> unit
end

module Textvariable : sig
  open Widget
  open Protocol

  type textVariable = Textvariable.textVariable
        (* TextVariable is an abstract type *)

  val create : ?on: widget -> unit -> textVariable
        (* Allocation of a textVariable with lifetime associated to widget
           if a widget is specified *)
  val create_temporary : widget -> textVariable
        (* for backward compatibility
           [create_temporary w] is equivalent to [create ~on:w ()] *)

  val set : textVariable -> string -> unit
        (* Setting the val of a textVariable *)
  val get : textVariable -> string
        (* Reading the val of a textVariable *)
  val name : textVariable -> string
        (* Its tcl name *)

  val cCAMLtoTKtextVariable : textVariable -> tkArgs
        (* Internal conversion function *)

  val handle : textVariable -> (unit -> unit) -> unit
        (* Callbacks on variable modifications *)

  val coerce : string -> textVariable

  (*-*)
  val free : textVariable -> unit
end

module Fileevent : sig
  open Unix

  val   add_fileinput : file_descr -> (unit -> unit) -> unit
  val   remove_fileinput: file_descr -> unit
  val   add_fileoutput : file_descr -> (unit -> unit) -> unit
  val   remove_fileoutput: file_descr -> unit
        (* see [tk] module *)
end

module Timer : sig
  type t = Timer.t

  val add : int -> (unit -> unit) -> t
  val set : int -> (unit -> unit) -> unit
  val remove : t -> unit
end

(*
Tkwait exists, but is not used in support
module Tkwait : sig
  val internal_tracevis : string -> Protocol.cbid -> unit
  val internal_tracedestroy : string -> Protocol.cbid -> unit
end
*)