-------------------------------------------------------------------
--           RAPID - RAPID ADA PORTABLE INTERFACE DESIGNER         
--           MCC-COMMON_DIALOGS
--           MSIL PEER IMPLEMENTATION                               
--           Copyright (C) 2002 Martin C. Carlisle.                
--                                                                 
-- RAPID is free software;  you can  redistribute it  and/or modify
-- it under terms of the  GNU General Public License as published  
-- by the Free Software  Foundation;  either version 2,  or (at your
-- option) any later version.  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.  See the GNU General Public License for more details.  
-- You should have  received  a copy of the GNU General Public License
-- distributed with RAPID; see file COPYING.  If not, write to the 
-- Free Software Foundation,  59 Temple Place - Suite 330,  Boston, 
-- MA 02111-1307, USA.                                                 
--                                                                     
-- As a special exception, if other files instantiate generics from
-- this unit, or you link this unit with other files to produce an 
-- executable, this unit does not by itself cause the resulting 
-- executable to be covered by the GNU General Public License.  
-- This exception does not however invalidate any other reasons 
-- why the executable file might be covered by the GNU Public 
-- License.  This exception does not apply to executables which
-- are GUI design tools, or that could act as a replacement
-- for RAPID.
------------------------------------------------------------------------------
with MSSyst.String;
use MSSyst.String;
with MSSyst.Windows.Forms;
use MSSyst.Windows.Forms;
with MSSyst.Windows.Forms.MessageBox;
with MSSyst.Windows.Forms.MessageBoxButtons;
with MSSyst.Windows.Forms.DialogResult;
with MSSyst.Windows.Forms.IWin32Window;
with MSSyst.Windows.Forms.Application;
with MSSyst.Windows.Forms.OpenFileDialog;
with MSSyst.Windows.Forms.SaveFileDialog;
with Ada.Strings.Unbounded;
use Ada.Strings.Unbounded;
with Ada.Unchecked_Conversion;
with peer;
package body Mcc.Common_Dialogs is
   Directory_Separator : constant Character := '\';
   
   function To_Iwin32window is new
      ada.Unchecked_Conversion(peer.peer,iwin32window.ref);
   ------------
   -- Ok_Box --
   ------------
   procedure Ok_Box (
         Message : in     String ) is 
      Ignore : DialogResult.Valuetype;  
   begin
      Ignore := MessageBox.Show(Message);
   end Ok_Box;

   -- Display message and wait for user to press "OK"
   procedure Ok_Box (
         Message : in     String;                               
         Parent  : in     Mcc.Gui.Container.Window.Window'Class ) is 
      Ignore : Dialogresult.Valuetype;  
   begin
      Ignore := MessageBox.Show(
         owner => to_IWin32Window(
            Mcc.Gui.Container.Window.Get_Peer(Parent)),
         text  => Message);
   end Ok_Box;

------------------------------------------------------------------------------
-- Here's a sample filter string from the .NET framework help
-- "Image Files(*.BMP;*.JPG;*.GIF)|*.BMP;*.JPG;*.GIF|All files (*.*)|*.*"
-- whereas the RAPID string looks like:
--   { "Tcl_Files" { .tcl .tk } }
--   { "All Files" * }
------------------------------------------------------------------------------
   function Change_Filter_String(
         File_Types : in String) return String is
      Result            : Unbounded_String := Null_Unbounded_String;
      Extensions        : Unbounded_String := Null_Unbounded_String;
      Current           : Natural := File_Types'First;
      Start_Description : Natural;
      End_Description   : Natural;
      Start_Extension   : Natural;
      End_Extension     : Natural;
      Done              : Boolean;
      First_Extension   : Boolean;
      First_Filter      : Boolean;
   begin
      First_Filter  := True;

      while Current < File_Types'Last loop
         -- loop until we either get a { marking a filter start, or
         -- the end of the string
         while File_Types(Current) /= '{' and Current < File_Types'Last loop
            Current := Current + 1;
         end loop;
         
         -- if we're not at the end yet, process this filter.
         if Current < File_Types'Last then
            Extensions      := Null_Unbounded_String;
            First_Extension := True;
            
            -- look for a " to begin the description
            while File_Types(Current) /= '"' loop
               Current := Current + 1;
            end loop;
            
            Current := Current + 1;
            Start_Description := Current;
            
            -- look for a " to end the description
            while File_Types(Current) /= '"' loop
               Current := Current + 1;
            end loop;
            
            End_Description := Current - 1;
            Done := False;
            -- look for the filter extensions
            while not Done loop
               while File_Types(Current) /= '*' and
                  File_Types(Current) /= '.' and
                  File_Types(Current) /= '}' loop
                  Current := Current + 1;
               end loop;
               
               -- if we hit } we're done,
               -- o/w, we saw * or ., which starts an extension
               if File_Types(Current) = '}' then
                  Done := True;
               else
                  if First_Extension = False then
                     Result := Result & ";";
                     Extensions := Extensions & ";";
                  else
                     if not First_Filter then
                        Result := Result & "|";
                     else
                        First_Filter := False;
                     end if;
                     
                     Result := Result &
                        File_Types(Start_Description..End_Description) &
                     " (";
                     First_Extension := False;
                  end if;
                  
                  if File_Types(Current) = '.' then
                     Start_Extension := Current+1;
                     Current := Current+1;
                     while File_Types(Current) /= ' ' and
                        File_Types(Current) /= '}' loop
                        Current := Current + 1;
                     end loop;
                     End_Extension := Current - 1;
                     
                     
                     Result := Result & "*." &
                        File_Types(Start_Extension..End_Extension);
                     Extensions := Extensions & "*." &
                        File_Types(Start_Extension..End_Extension);
                     
                  else
                     
                     Result := Result & "*.*";
                     Extensions := Extensions & "*.*";
                     -- move past the * filter
                     Current := Current + 1;
                  end if;
               end if;
            end loop;
            
            if First_Extension=False then
               Result := Result & ")";
               Result := Result & "|" & Extensions;
            end if;
         end if;
      end loop;
      return To_String(Result);      
   end Change_Filter_String;

   procedure Extract_Directory (
         Filename          : in     String;
         Directory         :    out String;            
         Dir_Last          :    out Natural) is
      Separator_Location : Natural;
   begin
      for I in reverse Filename'range loop
         if Filename(I) = Directory_Separator then
            Separator_Location := I;
            exit;
         end if;
      end loop;
      Dir_Last := Directory'First+Separator_Location-Filename'First;
      for I in Directory'First..Dir_Last loop
         Directory(I) := Filename(Filename'First+I-Directory'First);
      end loop;
   end Extract_Directory;
   
   -----------------
   -- Open_Dialog --
   -----------------

   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 
      use OpenFileDialog;
      Chooser : OpenFileDialog.Ref     := New_OpenFileDialog;  
      Result  : DialogResult.Valuetype; 
      use type DialogResult.Valuetype;
   begin
      Chooser.Set_Filter(Change_Filter_String(File_Types));
      Chooser.Set_Title(Title);
      if Initial_Directory /= "." then
         Chooser.Set_InitialDirectory(Initial_Directory);
      end if;
      if Default_Extension /= "" then
         Chooser.Set_DefaultExt(Default_Extension);
      end if;
      Chooser.Set_RestoreDirectory(not Change_Directory);
         
      Result := Chooser.ShowDialog;
      if Result=DialogResult.Cancel then
         File_Last := Filename'First-1;
      else
         declare
            Filename_Result : String := +Chooser.Get_Filename;
         begin
            File_Last := Filename'First+Filename_Result'Length-1;
            Filename(Filename'First..File_Last) := Filename_Result;
         end;
      end if;
   end Open_Dialog;

   -----------------
   -- 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
      Open_Dialog (
         File_Types        => File_Types,               
         Filename          => Filename,               
         File_Last         => File_Last,              
         Title             => Title, 
         Initial_Directory => Initial_Directory,     
         Default_Extension => Default_Extension,  
         Change_Directory  => Change_Directory);
      Extract_Directory(
         Filename  => Filename(Filename'First..File_Last),
         Directory => Directory,
         Dir_Last  => Dir_Last);
   end Open_Dialog;

   -----------------
   -- Quit_Dialog --
   -----------------

   procedure Quit_Dialog (
         Verify : Boolean := True ) is 
      Quit_Now : Boolean;  
   begin
      if Verify then
         Quit_Now := Yesno_Dialog(
            Message => "Are you sure you want to quit?", 
            Title   => "Exit now?");
         if Quit_Now then
            Application.Exit_K;
         end if;
      else
         Application.Exit_K;
      end if;
   end Quit_Dialog;

   -----------------
   -- Save_Dialog --
   -----------------

   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 
      use SaveFileDialog;
      Chooser : SaveFileDialog.Ref     := New_SaveFileDialog;  
      Result  : DialogResult.Valuetype; 
      use type DialogResult.Valuetype;
   begin
      Chooser.Set_Filter(Change_Filter_String(File_Types));
      Chooser.Set_Title(Title);
      if Initial_Directory /= "." then
         Chooser.Set_InitialDirectory(Initial_Directory);
      end if;
      if Default_Extension /= "" then
         Chooser.Set_DefaultExt(Default_Extension);
      end if;
      Chooser.Set_RestoreDirectory(not Change_Directory);
         
      Result := Chooser.ShowDialog;
      if Result=DialogResult.Cancel then
         File_Last := Filename'First-1;
      else
         declare
            Filename_Result : String := +Chooser.Get_Filename;
         begin
            File_Last := Filename'First+Filename_Result'Length-1;
            Filename(Filename'First..File_Last) := Filename_Result;
         end;
      end if;
   end Save_Dialog;

   -----------------
   -- 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
      Save_Dialog (
         File_Types        => File_Types,               
         Filename          => Filename,               
         File_Last         => File_Last,              
         Title             => Title, 
         Initial_Directory => Initial_Directory,     
         Default_Extension => Default_Extension,  
         Change_Directory  => Change_Directory);
      Extract_Directory(
         Filename  => Filename(Filename'First..File_Last),
         Directory => Directory,
         Dir_Last  => Dir_Last);
   end Save_Dialog;

   ------------------
   -- Yesno_Dialog --
   ------------------

   function Yesno_Dialog (
         Message : in     String; 
         Title   : in     String  ) 
     return Boolean is 
      Result : DialogResult.Valuetype;  
      use type DialogResult.Valuetype;
   begin
      Result := MessageBox.Show(Message,Title,MessageBoxButtons.YesNo);
      return Result=DialogResult.Yes;
   end Yesno_Dialog;

   ------------------
   -- Yesno_Dialog --
   ------------------

   function Yesno_Dialog (
         Message : in     String;                               
         Title   : in     String;                               
         Parent  : in     Mcc.Gui.Container.Window.Window'Class ) 
     return Boolean is 
      Result : DialogResult.Valuetype;  
      use type DialogResult.Valuetype;
   begin
      Result := MessageBox.Show(
         to_IWin32Window(
            Mcc.Gui.Container.Window.Get_Peer(Parent)),
         Message,Title,MessageBoxButtons.YesNo);
      return Result=DialogResult.Yes;
   end Yesno_Dialog;

   -------------------------
   -- Yesno_Cancel_Dialog --
   -------------------------

   function Yesno_Cancel_Dialog (
         Message : in     String; 
         Title   : in     String  ) 
     return Yesno_Cancel is 
      Result : DialogResult.Valuetype;  
      use type DialogResult.Valuetype;
   begin
      Result := MessageBox.Show(Message,Title,MessageBoxButtons.YesNo);
      case Result is
         when DialogResult.Yes =>
            return Yes;
         when DialogResult.No =>
            return No;
         when DialogResult.Cancel =>
            return Cancel;
         when others =>
            return Cancel;
      end case;
   end Yesno_Cancel_Dialog;

   -------------------------
   -- 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 : DialogResult.Valuetype;  
      use type DialogResult.Valuetype;
   begin
      Result := MessageBox.Show(
         to_IWin32Window(
            Mcc.Gui.Container.Window.Get_Peer(Parent)),
         Message,Title,MessageBoxButtons.YesNo);
      case Result is
         when DialogResult.Yes =>
            return Yes;
         when DialogResult.No =>
            return No;
         when DialogResult.Cancel =>
            return Cancel;
         when others =>
            return Cancel;
      end case;
   end Yesno_Cancel_Dialog;
end Mcc.Common_Dialogs;

