------------------------------------------------
--
-- tcl-tk.ads -- This package is a "thick" binding to Tk.
--
-- Copyright (c) 1995-1997 Terry J. Westley
--
-- See the file "license.htm" for information on usage and
-- redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
--
------------------------------------------------

with CArgv;

package Tcl.Tk is

   Version : constant String := "8.0b2.0";

   package C renames Interfaces.C;

   procedure Set_Trace (State : in Boolean);
   -- Turn on tracing of Tcl/Tk command execution.

   ---------------------------------------------
   --
   --	The Widget data type, parent of all objects displayed on the screen.
   --	
   --	It is abstract because it is just a convenience for creating a Widget
   --	class and for creating non-abstract derived widget types.  Since there
   --	is no such data type in Tk, we make it abstract so that no istance of
   --	type Widget may be created.
   --
   ---------------------------------------------

   type Widget is abstract tagged private;

   ---------------------------------------------
   --
   --	Widget path name constructors
   --
   ---------------------------------------------

   function Widget_Image (
      Win : in Widget'Class) return String;
   -- Returns the string name of Win.

   function "&" (
      Left  : in Widget'Class;
      Right : in Widget'Class) return String;
   function "&" (
      Left  : in Widget'Class;
      Right : in String) return String;
   function "&" (
      Left  : in String;
      Right : in Widget'Class) return String;
   -- Concatenates and returns the string names of Left and Right.
   -- Does not insert the separating dot.

   pragma Inline (Widget_Image, "&");

   procedure Set_Context (
      Interp : in Tcl_Interp);
   -- Sets the interpreter context for all Tk calls which do not include
   -- either an Interp or Widget parameter.

   function Get_Context return Tcl_Interp;
   -- Gets the current interpreter context.

   function Get_Interp (
      Widgt : in Widget'Class)
      return Tcl_Interp;
   -- Gets the interpreter of the specified Widget.

   ---------------------------------------------
   --
   --	Widget constructors
   --
   ---------------------------------------------

   function Create (
      pathName : in     String;
      options  : in     String := "") return Widget is abstract;
   procedure Create (
      Widgt    :    out Widget;
      pathName : in     String;
      options  : in     String := "") is abstract;
   -- Creates a new widget in the "contextual" interpreter.  Options
   -- may be specified via the "options" parameter or the option
   -- database to configure the widget.

   function Create (
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "") return Widget is abstract;
   procedure Create (
      Widgt    :    out Widget;
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "") is abstract;
   -- Creates a new widget in the specified interpreter.  Options
   -- may be specified via the "options" parameter or the option
   -- database to configure the widget.

   ---------------------------------------------
   --
   --	Widget destructor
   --
   ---------------------------------------------

   procedure Destroy (
      Widgt : in out Widget'Class);
   -- Destroys a widget.

   ---------------------------------------------
   --
   --	Widget configuration query and modify
   --
   ---------------------------------------------

   function cget (
      Widgt  : in Widget'Class;
      option : in String) return String;
   -- Returns the current value of the specified configuration option.

   function configure (
      Widgt   : in Widget'Class;
      options : in String := "") return String;
   procedure configure (
      Widgt   : in Widget'Class;
      options : in String := "");
   -- Queries or modifies the configuration options.  If options is
   -- an empty string, returns a list of all available options
   -- for the widget.

   ---------------------------------------------
   --
   --	Bind associates a Tcl script with an
   --	event.  The script is executed when
   --	the event occurs.
   --
   ---------------------------------------------

   procedure Bind (
      Widgt    : in Widget'class;
      Sequence : in String;
      Script   : in String);
   -- Associates Tcl script Script with the event Sequence.

   procedure Bind (
      Widgt    : in Widget'class;
      Sequence : in String);
   function Bind (
      Widgt    : in Widget'class;
      Sequence : in String) return String;
   -- Disassociates the binding from the event Sequence.

   procedure Bind_to_Main_Window (
      Interp   : in Tcl_Interp;
      Sequence : in String;
      Script   : in String);
   -- Associates Tcl script Script with the event Sequence in the main window.

   procedure Bind_to_Main_Window (
      Interp   : in Tcl_Interp;
      Sequence : in String);
   function Bind_to_Main_Window (
      Interp   : in Tcl_Interp;
      Sequence : in String) return String;
   -- Disassociates the binding from the event Sequence in the main window.

   ---------------------------------------------
   --
   --	Frame widget
   --	
   --	This is a non-abstract type derived directly from Widget.
   --   Each of the derived widgets redefines the Create subprogram
   --   in order to create the correct type of widget.
   --
   ---------------------------------------------

   type Frame is new Widget with private;

   function Create (
      pathName : in     String;
      options  : in     String := "") return Frame;
   procedure Create (
      Widgt    :    out Frame;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the "contextual" interpreter and makes
   -- it into a frame widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   function Create (
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "") return Frame;
   procedure Create (
      Widgt    :    out Frame;
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the specified interpreter and makes it
   -- into a frame widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   ---------------------------------------------
   --
   --	Toplevel widget
   --	
   ---------------------------------------------

   type Toplevel is new Frame with private;

   function Create (
      pathName : in     String;
      options  : in     String := "") return Toplevel;
   procedure Create (
      Widgt    :    out Toplevel;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the "contextual" interpreter and makes it
   -- into a toplevel widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   function Create (
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "") 
      return Toplevel;
   procedure Create (
      Widgt    :    out Toplevel;
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the specified interpreter and makes it
   -- into a toplevel widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   ---------------------------------------------
   --
   --	Label widget
   --
   ---------------------------------------------

   type Label is new Frame with private;

   function Create (
      pathName : in     String;
      options  : in     String := "") return Label;
   procedure Create (
      Widgt    :    out Label;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the "contextual" interpreter and makes it
   -- into a label widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   function Create (
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "") return Label;
   procedure Create (
      Widgt    :    out Label;
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "");
   -- into a label widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   ---------------------------------------------
   --
   --	Message widget
   --
   ---------------------------------------------

   type Message is new Frame with private;

   function Create (
      pathName : in     String;
      options  : in     String := "") 
      return Message;
   procedure Create (
      Widgt    :    out Message;
      pathName : in     String;
      options  : in     String := "") ;
   -- Creates a new widget in the "contextual" interpreter and makes it
   -- into a message widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   function Create (
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "") return Message;
   procedure Create (
      Widgt    :    out Message;
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the specified interpreter and makes it
   -- into a message widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   ---------------------------------------------
   --
   --	Button widget
   --
   ---------------------------------------------

   type Button is new Frame with private;

   function Create (
      pathName : in     String;
      options  : in     String := "") return Button;
   procedure Create (
      Widgt    :    out Button;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the "contextual" interpreter and makes it
   -- into a button widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   function Create (
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "") return Button;
   procedure Create (
      Widgt    :    out Button;
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "");
   -- into a button widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   procedure Flash (
      Buttn : in Button'class);
   -- Flash the button.

   function Invoke (
      Buttn : in Button'class;
      options  : in String := "") return String;
   -- Invoke the Tcl command associated with the button.

   ---------------------------------------------
   --
   --	RadioButton widget
   --
   ---------------------------------------------

   type RadioButton is new Button with private;

   function Create (
      pathName : in     String;
      options  : in     String := "") 
      return Radiobutton;
   procedure Create (
      Widgt    :    out RadioButton;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the "contextual" interpreter and makes it
   -- into a radiobutton widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   function Create (
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "")
      return Radiobutton;
   procedure Create (
      Widgt    :    out Radiobutton;
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the specified interpreter and makes it
   -- into a radiobutton widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   procedure Deselect (
      Buttn : in RadioButton);
   -- Deselect the button.

   procedure Tk_Select (
      Buttn : in RadioButton);
   -- Select the button.

   procedure Toggle (
      Buttn : in RadioButton);
   -- Toggle the button.

   ---------------------------------------------
   --
   --	Entry widget
   --
   ---------------------------------------------

   type EntryWidget is new Frame with private;

   function Create (
      pathName : in     String;
      options  : in     String := "") return EntryWidget;
   procedure Create (
      Widgt    :    out EntryWidget;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the "contextual" interpreter and makes it
   -- into a entry widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   function Create (
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "") return EntryWidget;
   procedure Create (
      Widgt    :    out EntryWidget;
      Interp   : in     Tcl_Interp;
      pathName : in     String;
      options  : in     String := "");
   -- Creates a new widget in the specified interpreter and makes it
   -- into a entry widget.  Options may be specified via the "options"
   -- parameter or the option database to configure the widget.

   function get (
      Widgt  : in EntryWidget) return String;
   -- Returns the entry's string.

   ---------------------------------------------
   --
   --	After commands
   --	
   --	These commands delay execution and schedule (and unschedule)
   --   future execution of Tcl commands.
   --
   ---------------------------------------------

   procedure After (
      Ms     : in Natural);
   -- Sleeps for Ms milliseconds in the "contextual" interpreter.

   procedure After (
      Interp : in Tcl_Interp;
      Ms     : in Natural);
   -- Sleeps for Ms milliseconds in the specified interpreter.

   function  After (
      Ms     : in Natural;
      Script : in String) return String;
   procedure After (
      Ms     : in Natural;
      Script : in String);
   -- Arranges for the Tcl Script to be executed after Ms milliseconds
   -- in the "contextual" interpreter.  The function returns an
   -- identifier suitable for canceling the command.

   function  After (
      Interp : in Tcl_Interp;
      Ms     : in Natural;
      Script : in String) return String;
   procedure After (
      Interp : in Tcl_Interp;
      Ms     : in Natural;
      Script : in String);
   -- Arranges for the Tcl Script to be executed after Ms milliseconds
   -- in the specified interpreter.  The function returns an
   -- identifier suitable for canceling the command.

   procedure Cancel (
      id_or_script : in String);
   -- Cancels the execution of a delayed command in the "contextual"
   -- interpreter. 

   procedure Cancel (
      Interp       : in Tcl_Interp;
      id_or_script : in String);
   -- Cancels the execution of a delayed command in the specified
   -- interpreter.

   function  Idle (
      Script : in String) return String;
   procedure Idle (
      Script : in String);
   -- Arranges for the Tcl Script to be executed later as an idle
   -- handler in the "contextual" interpreter.  The function returns
   -- an identifier suitable for canceling the command.

   function  Idle (
      Interp : in Tcl_Interp;
      Script : in String) return String;
   procedure Idle (
      Interp : in Tcl_Interp;
      Script : in String);
   -- Arranges for the Tcl Script to be executed later as an idle
   -- handler in the specified interpreter.  The function returns
   -- an identifier suitable for canceling the command.

   function Info (
      id     : in String := "") return String;
   -- Returns information about existing event handlers in the
   -- "contextual" interpreter. 

   function Info (
      Interp : in Tcl_Interp;
      id     : in String := "") return String;
   -- Returns information about existing event handlers in the
   -- "contextual" interpreter.

   ---------------------------------------------
   --
   --	Pack commands
   --	
   --	These commands provide for packing widgets within other
   --   widgets and therefore rendering them to the screen.
   --
   ---------------------------------------------

   procedure Pack (
      Slave   : in Widget'Class;
      Options : in String);
   procedure Pack_Configure (
      Slave   : in Widget'Class;
      Options : in String);
   -- Tells the packer how to configure the specified Slave window.

   procedure Pack_Forget (
      Slave   : in Widget'Class);
   -- Removes the Slave window from the packing list for its master
   -- and unmaps their windows.

   function Pack_Info (
      Slave   : in Widget'Class) return String;
   -- Returns a list whose elements are the current configuration
   -- state of the specified Slave window.

   procedure Pack_Propogate (
      Master  : in Widget'Class;
      State   : in Boolean);
   -- Enables or disables propogation for the specified Master window.

   function Pack_Propogate (
      Master  : in Widget'Class) return Boolean;
   -- Returns state of propogation in the specified Master window.

   function Pack_Slaves (
      Master  : in Widget'Class) return String;
   -- Returns a list of slaves in the packing order of the specified
   -- Master window. 

   ---------------------------------------------
   --
   --	tk.h functions
   --	
   --	This is a "thin" binding to tk.h functions.
   --
   ---------------------------------------------

   function Init (
      interp          : in Tcl_Interp) 
      return C.Int;
   pragma Import (C, Init, "Tk_Init");

   function SafeInit (
      interp          : in Tcl_Interp) 
      return C.Int;
   pragma Import (C, SafeInit, "Tk_SafeInit");

   procedure Main (
      argc            : in C.Int;
      argv            : in CArgv.Chars_Ptr_Ptr;
      appInitProc     : in Tcl_AppInitProc);
   pragma Import (C, Main, "Tk_Main");

   procedure DoOneEvent (
      flags           : in C.Int);
   pragma Import (C, DoOneEvent, "Tk_DoOneEvent");

   procedure MainLoop;
   pragma Import (C, MainLoop, "Tk_MainLoop");

   function GetNumMainWidgets return C.Int;
   pragma Import (C, GetNumMainWidgets, "Tk_GetNumMainWidgets");

private

   type Widget is abstract tagged
      record
         Name   : C.Strings.Chars_Ptr;
	 Interp : Tcl_Interp;
      end record;

   Context : Tcl_Interp;

   procedure Execute_Widget_Command (
      Widgt   : in Widget'Class;
      command : in String;
      options : in String := "");

   type Frame       is new Widget with null record;
   type Toplevel    is new Frame  with null record;
   type Label       is new Frame  with null record;
   type Message     is new Frame  with null record;
   type Button      is new Frame  with null record;
   type RadioButton is new Button with null record;
   type EntryWidget is new Frame  with null record;

end Tcl.Tk;