---------------------------------------------------------------
--                                                           
--  RAPID - Rapid Ada Portable Interface Designer     
--                                                           
--  COMMON_DIALOGS.ADB 
--  Description : Implementation of Common Dialogs in Tcl/Tk
--                       
--  By: Martin Carlisle
--                                         
-- RAPID is free software; you can redistribute it and/or 
-- modify it without restriction.  However, we ask that you
-- please retain the original author information, and clearly  
-- indicate if it has been modified.
--
-- RAPID 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.  
--
---------------------------------------------------------------
with Peer;
with Tcl.Ada;
with Tcl_Utilities;

package body Mcc.Common_Dialogs is

   procedure Ok_Box(
      Message       : in String) is
      Interp : Tcl.Tcl_Interp := Peer.Get_Interp;
      
   begin -- Ok_Box
      Tcl.Ada.Tcl_Eval(Interp,"tk_messageBox -message """ &
         Tcl_Utilities.Fix_Quotes(Message) & """");
   end Ok_Box;

   -- Display message and wait for user to press "OK"
   -- make sure parent stays on top
   procedure Ok_Box (
         Message : in     String;                               
         Parent  : in     Mcc.Gui.Container.Window.Window'Class ) is 
      Interp : Tcl.Tcl_Interp := Peer.Get_Interp;  
   begin
      Tcl.Ada.Tcl_Eval(Interp,"tk_messageBox -message """ &
         Tcl_Utilities.Fix_Quotes(Message) & """" &
         " -parent " & Mcc.Gui.Container.Window.Get_Peer(Parent).Name.all);
   end Ok_Box;


   procedure Quit_Dialog(
      Verify : Boolean := True) is
      Interp : Tcl.Tcl_Interp := Peer.Get_Interp;

   begin
      if Verify then
         Tcl.Ada.Tcl_Eval(Interp,"set result [" &
            "tk_messageBox -parent . " &
            "-message """ &
            "Do you really want to quit?"" " &
            "-icon warning -title {Exit?} -type yesno]");
         Tcl.Ada.Tcl_Eval(Interp,"if { $result == ""yes"" } " &
            "{ exit }");
      else
         Tcl.Ada.Tcl_Eval(Interp,"exit");
      end if;
   end Quit_Dialog;

   function Yesno_Dialog(
         Message       : in String;
         Title         : in String) return Boolean is
      Result      : String(1..5);
      Result_Last : Integer;
      Interp      : Tcl.Tcl_Interp := Peer.Get_Interp;
   begin
      Tcl.Ada.Tcl_Eval(Interp,"set result [" &
         "tk_messageBox " &
         " -message """ &
         Tcl_Utilities.Fix_Quotes(Message) & '"' &
         " -icon question -title {""" & Title & """} -type yesno]");
      Tcl_Utilities.Get_Value(Interp => Interp,
         Name   => "result",
         Result => Result,
         Last   => Result_last);
      -- we can tell which it is based on the length of the result
      if Result_Last = 3 then
         return True;
      else
         return False;
      end if;
   end Yesno_Dialog;


   function Yesno_Dialog(
         Message : in String;
         Title   : in String;
         Parent  : in Mcc.Gui.Container.Window.Window'Class) 
      return Boolean is
      Result      : String(1..5);
      Result_Last : Integer;
      Interp      : Tcl.Tcl_Interp := Peer.Get_Interp;
   begin
      Tcl.Ada.Tcl_Eval(Interp,"set result [" &
         "tk_messageBox " &
         " -parent " & Mcc.Gui.Container.Window.Get_Peer(Parent).Name.all &
         " -message """ &
         Tcl_Utilities.Fix_Quotes(Message) & '"' &
         " -icon question -title {""" & Title & """} -type yesno]");
      Tcl_Utilities.Get_Value(Interp => Interp,
         Name   => "result",
         Result => Result,
         Last   => Result_last);
      -- we can tell which it is based on the length of the result
      if Result_Last = 3 then
         return True;
      else
         return False;
      end if;
   end Yesno_Dialog;

   function Yesno_Cancel_Dialog(
         Message       : in String;
         Title         : in String) return Yesno_Cancel is
      Result      : String(1..5);
      Result_Last : Integer;
      Interp      : Tcl.Tcl_Interp := Peer.Get_Interp;
   begin
      Tcl.Ada.Tcl_Eval(Interp,"set result [" &
         "tk_messageBox " &
         " -message """ &
         Tcl_Utilities.Fix_Quotes(Message) & '"' &
         " -icon question -title {""" & Title & """} -type yesnocancel]");
      Tcl_Utilities.Get_Value(Interp => Interp,
         Name   => "result",
         Result => Result,
         Last   => Result_last);
      -- we can tell which it is based on the length of the result
      if Result_Last = 3 then
         return Yes;
      elsif Result_Last = 2 then
         return No;
      else
         return Cancel;
      end if;
   end Yesno_Cancel_Dialog;


   function Yesno_Cancel_Dialog(
         Message : in String;
         Title   : in String;
         Parent  : in Mcc.Gui.Container.Window.Window'Class) 
      return Yesno_Cancel is
      Result      : String(1..5);
      Result_Last : Integer;
      Interp      : Tcl.Tcl_Interp := Peer.Get_Interp;
   begin
      Tcl.Ada.Tcl_Eval(Interp,"set result [" &
         "tk_messageBox " &
         " -parent " & Mcc.Gui.Container.Window.Get_Peer(Parent).Name.all &
         " -message """ &
         Tcl_Utilities.Fix_Quotes(Message) & '"' &
         " -icon question -title {""" & Title & """} -type yesnocancel]");
      Tcl_Utilities.Get_Value(Interp => Interp,
         Name   => "result",
         Result => Result,
         Last   => Result_last);
      -- we can tell which it is based on the length of the result
      if Result_Last = 3 then
         return Yes;
      elsif Result_Last = 2 then
         return No;
      else
         return Cancel;
      end if;
   end Yesno_Cancel_Dialog;

   type File_Dialog_Type is (Open,Save);
   procedure Do_File_Dialog(
      File_Types : in String;
      Filename   : out String;
      File_Last  : out Natural;
      Directory  : out String;
      Dir_Last   : out Natural;
      Title      : in String;
      Initial_Directory : in String;
      Dialog_Type : File_Dialog_Type;
      Default_Extension : in String;
      Change_Directory  : in Boolean) is
      Dialog_Command : String(1..14);
      Interp : Tcl.Tcl_Interp := Peer.Get_Interp;      
   begin
      if Dialog_Type = Open then
         Dialog_Command := "tk_getOpenFile";
      else
         Dialog_Command := "tk_getSaveFile";
      end if;
      Tcl.Ada.Tcl_Eval(Interp,
         "set file_types { " & File_Types & " }");
      Tcl.Ada.Tcl_Eval(Interp,
         "set filename [" & Dialog_Command &
         " -filetypes $file_types" &
         " -initialdir """ & Initial_Directory & """" &
         " -defaultextension """ & Default_Extension & """" &
         " -title """ & Title & """" &
         " -parent .]");
      Tcl.Ada.Tcl_Eval(Interp,
         "set initialdir [file dirname $filename]");
      if Change_Directory then
         Tcl.Ada.Tcl_Eval(Interp,
            "cd $initialdir");
      end if;
      Tcl_Utilities.Get_Value(Interp => Interp,
         Name   => "filename",
         Result => Filename,
         Last   => File_last);
      Tcl_Utilities.Get_Value(Interp => Interp,
         Name   => "initialdir",
         Result => Directory,
         Last   => Dir_last);
   end Do_File_Dialog;

   -- Ask user for filename to open
   -- File_Types should look like :
   --   { "Tcl_Files" { .tcl .tk } }
   --   { "All Files" * }
   procedure Open_Dialog(
      File_Types : in String;
      Filename   : out String;
      File_Last  : out Natural;
      Title      : in String := "Open";
      Initial_Directory : in String := ".";
      Default_Extension : in String := "";
      Change_Directory  : in Boolean := True) is
      Directory : String(1..1024);
      Dir_Last  : natural;
   begin
      Open_Dialog(File_Types,Filename,File_Last,Directory,
         Dir_Last, Title, Initial_Directory,
         Default_Extension,Change_Directory);
   end Open_Dialog;

   procedure Open_Dialog(
      File_Types : in String;
      Filename   : out String;
      File_Last  : out Natural;
      Directory  : out String;
      Dir_Last   : out Natural;
      Title      : in String := "Open";
      Initial_Directory : in String := ".";
      Default_Extension : in String := "";
      Change_Directory  : in Boolean := True) is
   begin
      Do_File_Dialog(File_Types,Filename,File_Last,
         Directory,Dir_Last,Title,Initial_Directory,Open,
         Default_Extension,Change_Directory);
   end Open_Dialog;

   -- Ask user for filename to Save
   -- File_Types should look like :
   --   { "Tcl_Files" { .tcl .tk } }
   --   { "All Files" * }
   procedure Save_Dialog(
      File_Types : in String;
      Filename   : out String;
      File_Last  : out Natural;
      Title      : in String := "Save As";
      Initial_Directory : in String := ".";
      Default_Extension : in String := "";
      Change_Directory  : in Boolean := True) is
      Directory : String(1..1024);
      Dir_Last  : natural;
   begin
      Save_Dialog(File_Types,Filename,File_Last,Directory,
         Dir_Last, Title, Initial_Directory,
         Default_Extension,Change_Directory);
   end Save_Dialog;

   procedure Save_Dialog(
      File_Types : in String;
      Filename   : out String;
      File_Last  : out Natural;
      Directory  : out String;
      Dir_Last   : out Natural;
      Title      : in String := "Save As";
      Initial_Directory : in String := ".";
      Default_Extension : in String := "";
      Change_Directory  : in Boolean := True) is
   begin
      Do_File_Dialog(File_Types,Filename,File_Last,
         Directory,Dir_Last,Title,Initial_Directory,Save,
         Default_Extension,Change_Directory);
   end Save_Dialog;
end Mcc.Common_Dialogs;
