1------------------------------------------------------------------------------
2--                  GtkAda - Ada95 binding for Gtk+/Gnome                   --
3--                                                                          --
4--                       Copyright (C) 2013-2015, AdaCore                   --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24with Interfaces.C.Strings;       use Interfaces.C.Strings;
25with Ada.Unchecked_Conversion;
26
27with Glib.Application;           use Glib.Application;
28with Glib.Properties;            use Glib.Properties;
29with Glib.Values;                use Glib.Values;
30
31with Gtk.Arguments;              use Gtk.Arguments;
32with Gtkada.Bindings;            use Gtkada.Bindings;
33
34package body Gtkada.Application is
35
36   function Cb_To_Address is new Ada.Unchecked_Conversion
37     (Cb_Gtkada_Application_Files, System.Address);
38   function Address_To_Cb is new Ada.Unchecked_Conversion
39     (System.Address, Cb_Gtkada_Application_Files);
40
41   procedure Marsh_Gapplication_Files
42      (Closure         : GClosure;
43       Return_Value    : Glib.Values.GValue;
44       N_Params        : Glib.Guint;
45       Params          : Glib.Values.C_GValues;
46       Invocation_Hint : System.Address;
47       User_Data       : System.Address);
48   pragma Convention (C, Marsh_Gapplication_Files);
49
50   -------------
51   -- Gtk_New --
52   -------------
53
54   procedure Gtk_New
55     (Self           : out Gtkada_Application;
56      Application_Id : UTF8_String := "";
57      Flags          : Glib.Application.GApplication_Flags;
58      Gtkada_Flags   : Gtkada_Application_Flags)
59   is
60   begin
61      Self := new Gtkada_Application_Record;
62      Gtkada.Application.Initialize
63        (Self, Application_Id, Flags, Gtkada_Flags);
64   end Gtk_New;
65
66   ----------------
67   -- Initialize --
68   ----------------
69
70   procedure Initialize
71     (Self           : not null access Gtkada_Application_Record'Class;
72      Application_Id : UTF8_String := "";
73      Flags          : Glib.Application.GApplication_Flags;
74      Gtkada_Flags   : Gtkada_Application_Flags)
75   is
76      procedure C_Setup
77        (Obj   : System.Address;
78         Flags : Gtkada_Application_Flags);
79      pragma Import (C, C_Setup, "ada_gtk_setup_application");
80
81      Value : GValue;
82
83   begin
84      if not Self.Is_Created then
85         Gtk.Application.Initialize (Self, Application_Id, Flags);
86      else
87         Set_Property (Self, Application_Id_Property, Application_Id);
88
89         Init (Value, GType_Int);
90         Set_Int (Value, Gint (Flags));
91         Set_Property (Self, Property_Name (Flags_Property), Value);
92         Unset (Value);
93      end if;
94
95      C_Setup (Self.Get_Object, Gtkada_Flags);
96   end Initialize;
97
98   -------------------------
99   -- Gtk_Application_New --
100   -------------------------
101
102   function Gtk_Application_New
103     (Application_Id : UTF8_String := "";
104      Flags          : Glib.Application.GApplication_Flags;
105      Gtkada_Flags   : Gtkada_Application_Flags)
106      return Gtkada_Application
107   is
108      Ret : constant Gtkada_Application := new Gtkada_Application_Record;
109   begin
110      Gtkada.Application.Initialize
111        (Ret, Application_Id, Flags, Gtkada_Flags);
112
113      return Ret;
114   end Gtk_Application_New;
115
116   --------------
117   -- Get_Path --
118   --------------
119
120   function Get_Path (File : GFile) return UTF8_String is
121      function Internal (File : GFile) return Interfaces.C.Strings.chars_ptr;
122      pragma Import (C, Internal, "g_file_get_path");
123      C_Path : Interfaces.C.Strings.chars_ptr := Internal (File);
124      Path   : constant String := Interfaces.C.Strings.Value (C_Path);
125
126   begin
127      Interfaces.C.Strings.Free (C_Path);
128      return Path;
129   end Get_Path;
130
131   -------------
132   -- On_Open --
133   -------------
134
135   procedure On_Open
136     (Self      : not null access Gtkada_Application_Record;
137      Call      : Cb_Gtkada_Application_Files)
138   is
139   begin
140      Unchecked_Do_Signal_Connect
141        (Object      => Self,
142         C_Name      => Glib.Application.Signal_Open & ASCII.NUL,
143         Marshaller  => Marsh_Gapplication_Files'Access,
144         Handler     => Cb_To_Address (Call),
145         After       => False);
146   end On_Open;
147
148   ------------------------------
149   -- Marsh_Gapplication_Files --
150   ------------------------------
151
152   procedure Marsh_Gapplication_Files
153      (Closure         : GClosure;
154       Return_Value    : Glib.Values.GValue;
155       N_Params        : Glib.Guint;
156       Params          : Glib.Values.C_GValues;
157       Invocation_Hint : System.Address;
158       User_Data       : System.Address)
159   is
160      pragma Unreferenced
161        (N_Params, Invocation_Hint, Return_Value, User_Data);
162      H     : constant Cb_Gtkada_Application_Files :=
163                Address_To_Cb (Get_Callback (Closure));
164      Obj   : constant Gtkada_Application :=
165                Gtkada_Application (Unchecked_To_Object (Params, 0));
166      Ptr   : constant System.Address := Unchecked_To_Address (Params, 1);
167      Nb    : constant Glib.Gint := Unchecked_To_Gint (Params, 2);
168      Files : GFile_Array (1 .. Natural (Nb));
169      pragma Import (Ada, Files);  --  suppress default initialization
170      for Files'Address use Ptr;
171
172   begin
173      H (Obj, Files);
174      exception when E : others => Process_Exception (E);
175   end Marsh_Gapplication_Files;
176
177end Gtkada.Application;
178