1------------------------------------------------------------------------------
2--                  GtkAda - Ada95 binding for Gtk+/Gnome                   --
3--                                                                          --
4--                     Copyright (C) 2001-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
24package body Glib.Convert is
25
26   procedure g_free (S : chars_ptr);
27   pragma Import (C, g_free, "g_free");
28
29   function g_convert
30     (Str           : String;
31      Len           : Gsize;
32      To_Codeset    : String;
33      From_Codeset  : String;
34      Bytes_Read    : access Gsize;
35      Bytes_Written : access Gsize;
36      Error         : GError_Access) return chars_ptr;
37
38   function g_convert
39     (Str           : chars_ptr;
40      Len           : Gsize;
41      To_Codeset    : String;
42      From_Codeset  : String;
43      Bytes_Read    : access Gsize;
44      Bytes_Written : access Gsize;
45      Error         : GError_Access) return chars_ptr;
46
47   pragma Import (C, g_convert, "g_convert");
48
49   -------------
50   -- Convert --
51   -------------
52
53   procedure Convert
54     (Str           : String;
55      To_Codeset    : String;
56      From_Codeset  : String;
57      Bytes_Read    : out Natural;
58      Bytes_Written : out Natural;
59      Error         : GError_Access := null;
60      Result        : out String)
61   is
62      Read    : aliased Gsize;
63      Written : aliased Gsize;
64      S       : chars_ptr;
65
66   begin
67      S := g_convert
68        (Str, Str'Length, To_Codeset & ASCII.NUL, From_Codeset & ASCII.NUL,
69         Read'Access, Written'Access, Error);
70      Bytes_Read := Natural (Read);
71      Bytes_Written := Natural (Written);
72
73      declare
74         Res : constant String := Value (S);
75      begin
76         Result (Result'First .. Result'First + Bytes_Written - 1) := Res;
77      end;
78
79      g_free (S);
80   end Convert;
81
82   function Convert
83     (Str           : String;
84      To_Codeset    : String;
85      From_Codeset  : String;
86      Error         : GError_Access := null) return String
87   is
88      Read    : aliased Gsize;
89      Written : aliased Gsize;
90      S       : chars_ptr;
91
92   begin
93      S := g_convert
94        (Str, Str'Length, To_Codeset & ASCII.NUL, From_Codeset & ASCII.NUL,
95         Read'Access, Written'Access, Error);
96
97      if S = Null_Ptr then
98         return "";
99      else
100         declare
101            Res : constant String := Value (S);
102         begin
103            g_free (S);
104            return Res;
105         end;
106      end if;
107   end Convert;
108
109   procedure Convert
110     (Str           : chars_ptr;
111      Len           : Natural;
112      To_Codeset    : String;
113      From_Codeset  : String;
114      Bytes_Read    : out Natural;
115      Bytes_Written : out Natural;
116      Error         : GError_Access := null;
117      Result        : out String)
118   is
119      Read    : aliased Gsize;
120      Written : aliased Gsize;
121      S       : chars_ptr;
122
123   begin
124      S := g_convert
125        (Str, Gsize (Len), To_Codeset & ASCII.NUL, From_Codeset & ASCII.NUL,
126         Read'Access, Written'Access, Error);
127      Bytes_Read := Natural (Read);
128      Bytes_Written := Natural (Written);
129
130      if S = Null_Ptr then
131         Bytes_Written := 0;
132      else
133         declare
134            Res : constant String := Value (S);
135         begin
136            Result (Result'First .. Result'First + Bytes_Written - 1) := Res;
137         end;
138         g_free (S);
139      end if;
140   end Convert;
141
142   function Convert
143     (Str           : String;
144      To_Codeset    : String;
145      From_Codeset  : String;
146      Bytes_Read    : access Natural;
147      Bytes_Written : access Natural;
148      Error         : GError_Access := null) return chars_ptr
149   is
150      Read    : aliased Gsize;
151      Written : aliased Gsize;
152      S       : chars_ptr;
153
154   begin
155      S := g_convert
156        (Str, Str'Length, To_Codeset & ASCII.NUL, From_Codeset & ASCII.NUL,
157         Read'Access, Written'Access, Error);
158      Bytes_Read.all := Natural (Read);
159      Bytes_Written.all := Natural (Written);
160      return S;
161   end Convert;
162
163   function Convert
164     (Str           : chars_ptr;
165      Len           : Natural;
166      To_Codeset    : String;
167      From_Codeset  : String;
168      Bytes_Read    : access Natural;
169      Bytes_Written : access Natural;
170      Error         : GError_Access := null) return chars_ptr
171   is
172      Read    : aliased Gsize;
173      Written : aliased Gsize;
174      S       : chars_ptr;
175
176   begin
177      S := g_convert
178        (Str, Gsize (Len), To_Codeset & ASCII.NUL, From_Codeset & ASCII.NUL,
179         Read'Access, Written'Access, Error);
180      Bytes_Read.all := Natural (Read);
181      Bytes_Written.all := Natural (Written);
182      return S;
183   end Convert;
184
185   -----------------------
186   -- Filename_From_URI --
187   -----------------------
188
189   function Filename_From_URI
190     (URI      : String;
191      Hostname : access chars_ptr;
192      Error    : GError_Access := null) return String
193   is
194      function Internal
195        (URI      : String;
196         Hostname : access chars_ptr;
197         Error    : GError_Access) return chars_ptr;
198      pragma Import (C, Internal, "ada_g_filename_from_uri");
199
200      S   : constant chars_ptr := Internal (URI & ASCII.NUL, Hostname, Error);
201      Str : constant String := Value (S);
202
203   begin
204      g_free (S);
205      return Str;
206   end Filename_From_URI;
207
208   ------------------------
209   -- Filename_From_UTF8 --
210   ------------------------
211
212   function Filename_From_UTF8
213     (UTF8_String : String;
214      Error       : GError_Access := null) return String
215   is
216      function Internal
217        (UTF8_String   : String;
218         Len           : Gsize;
219         Bytes_Read    : System.Address := System.Null_Address;
220         Bytes_Written : System.Address := System.Null_Address;
221         Error         : GError_Access) return chars_ptr;
222      pragma Import (C, Internal, "ada_g_filename_from_utf8");
223
224      S   : constant chars_ptr := Internal
225        (UTF8_String, UTF8_String'Length, Error => Error);
226      Str : constant String := Value (S);
227
228   begin
229      g_free (S);
230      return Str;
231   end Filename_From_UTF8;
232
233   ---------------------
234   -- Filename_To_URI --
235   ---------------------
236
237   function Filename_To_URI
238     (Filename : String;
239      Hostname : String := "";
240      Error    : GError_Access := null) return String
241   is
242      function Internal
243        (URI      : String;
244         Hostname : System.Address;
245         Error    : GError_Access) return chars_ptr;
246      pragma Import (C, Internal, "ada_g_filename_to_uri");
247
248      S    : chars_ptr;
249      Host : aliased constant String := Hostname & ASCII.NUL;
250
251   begin
252      if Hostname = "" then
253         S := Internal (Filename & ASCII.NUL, System.Null_Address, Error);
254      else
255         S := Internal (Filename & ASCII.NUL, Host'Address, Error);
256      end if;
257
258      declare
259         Str : constant String := Value (S);
260      begin
261         g_free (S);
262         return Str;
263      end;
264   end Filename_To_URI;
265
266   ----------------------
267   -- Filename_To_UTF8 --
268   ----------------------
269
270   function Filename_To_UTF8
271     (OS_String : String;
272      Error     : GError_Access := null) return String
273   is
274      function Internal
275        (OS_String     : String;
276         Len           : Gsize;
277         Bytes_Read    : System.Address := System.Null_Address;
278         Bytes_Written : System.Address := System.Null_Address;
279         Error         : GError_Access) return chars_ptr;
280      pragma Import (C, Internal, "ada_g_filename_to_utf8");
281
282      S   : constant chars_ptr := Internal
283        (OS_String, OS_String'Length, Error => Error);
284   begin
285      if S /= Null_Ptr then
286         return Str : constant String := Value (S) do
287            g_free (S);
288         end return;
289      else
290         g_free (S);
291         return "";
292      end if;
293   end Filename_To_UTF8;
294
295   ----------------------
296   -- Locale_From_UTF8 --
297   ----------------------
298
299   procedure Locale_From_UTF8
300     (UTF8_String   : String;
301      Bytes_Read    : out Natural;
302      Bytes_Written : out Natural;
303      Error         : GError_Access := null;
304      Result        : out String)
305   is
306      function Internal
307        (UTF8_String   : String;
308         Len           : Gsize;
309         Bytes_Read    : access Gsize;
310         Bytes_Written : access Gsize;
311         Error         : GError_Access) return chars_ptr;
312      pragma Import (C, Internal, "g_locale_from_utf8");
313
314      Read    : aliased Gsize;
315      Written : aliased Gsize;
316      S       : chars_ptr;
317
318   begin
319      S := Internal
320        (UTF8_String, UTF8_String'Length, Read'Access, Written'Access, Error);
321      Bytes_Read := Natural (Read);
322      Bytes_Written := Natural (Written);
323
324      declare
325         Res : constant String := Value (S);
326      begin
327         Result (Result'First .. Result'First + Bytes_Written - 1) := Res;
328      end;
329
330      g_free (S);
331   end Locale_From_UTF8;
332
333   function Locale_From_UTF8
334     (UTF8_String   : String;
335      Bytes_Read    : access Natural;
336      Bytes_Written : access Natural;
337      Error         : GError_Access := null) return chars_ptr
338   is
339      function Internal
340        (UTF8_String   : String;
341         Len           : Gsize;
342         Bytes_Read    : access Gsize;
343         Bytes_Written : access Gsize;
344         Error         : GError_Access) return chars_ptr;
345      pragma Import (C, Internal, "g_locale_from_utf8");
346
347      Read    : aliased Gsize;
348      Written : aliased Gsize;
349      S       : chars_ptr;
350
351   begin
352      S := Internal
353        (UTF8_String, UTF8_String'Length, Read'Access, Written'Access, Error);
354      Bytes_Read.all := Natural (Read);
355      Bytes_Written.all := Natural (Written);
356      return S;
357   end Locale_From_UTF8;
358
359   function Locale_From_UTF8 (UTF8_String : String) return String is
360      function Internal
361        (UTF8_String   : String;
362         Len           : Gsize;
363         Bytes_Read    : System.Address := System.Null_Address;
364         Bytes_Written : System.Address := System.Null_Address;
365         Error         : GError_Access := null) return chars_ptr;
366      pragma Import (C, Internal, "g_locale_from_utf8");
367
368      S : constant chars_ptr := Internal (UTF8_String, UTF8_String'Length);
369
370   begin
371      if S = Null_Ptr then
372         return "";
373      else
374         declare
375            Str : constant String := Value (S);
376         begin
377            g_free (S);
378            return Str;
379         end;
380      end if;
381   end Locale_From_UTF8;
382
383   --------------------
384   -- Locale_To_UTF8 --
385   --------------------
386
387   procedure Locale_To_UTF8
388     (OS_String     : String;
389      Bytes_Read    : out Natural;
390      Bytes_Written : out Natural;
391      Error         : GError_Access := null;
392      Result        : out String)
393   is
394      function Internal
395        (UTF8_String   : String;
396         Len           : Gsize;
397         Bytes_Read    : access Gsize;
398         Bytes_Written : access Gsize;
399         Error         : GError_Access) return chars_ptr;
400      pragma Import (C, Internal, "g_locale_to_utf8");
401
402      Read    : aliased Gsize;
403      Written : aliased Gsize;
404      S       : chars_ptr;
405
406   begin
407      S := Internal
408        (OS_String, OS_String'Length, Read'Access, Written'Access, Error);
409
410      Bytes_Read := Natural (Read);
411      Bytes_Written := Natural (Written);
412
413      if S = Null_Ptr then
414         return;
415      end if;
416
417      declare
418         Res : constant String := Value (S);
419      begin
420         Result (Result'First .. Result'First + Bytes_Written - 1) := Res;
421      end;
422
423      g_free (S);
424   end Locale_To_UTF8;
425
426   function Locale_To_UTF8
427     (OS_String     : String;
428      Bytes_Read    : access Natural;
429      Bytes_Written : access Natural;
430      Error         : GError_Access := null) return chars_ptr
431   is
432      function Internal
433        (OS_String     : String;
434         Len           : Gsize;
435         Bytes_Read    : access Gsize;
436         Bytes_Written : access Gsize;
437         Error         : GError_Access) return chars_ptr;
438      pragma Import (C, Internal, "g_locale_to_utf8");
439
440      Read    : aliased Gsize;
441      Written : aliased Gsize;
442      S       : chars_ptr;
443
444   begin
445      S := Internal
446        (OS_String, OS_String'Length, Read'Access, Written'Access, Error);
447      Bytes_Read.all := Natural (Read);
448      Bytes_Written.all := Natural (Written);
449      return S;
450   end Locale_To_UTF8;
451
452   function Locale_To_UTF8 (OS_String : String) return String is
453      function Internal
454        (OS_String     : String;
455         Len           : Gsize;
456         Bytes_Read    : System.Address := System.Null_Address;
457         Bytes_Written : System.Address := System.Null_Address;
458         Error         : GError_Access := null) return chars_ptr;
459      pragma Import (C, Internal, "g_locale_to_utf8");
460
461      S : constant chars_ptr := Internal (OS_String, OS_String'Length);
462
463   begin
464      if S = Null_Ptr then
465         return "";
466
467      else
468         declare
469            Str : constant String := Value (S);
470         begin
471            g_free (S);
472            return Str;
473         end;
474      end if;
475   end Locale_To_UTF8;
476
477   -----------------
478   -- Escape_Text --
479   -----------------
480
481   function Escape_Text (S : String) return String is
482      function Internal (S : String; L : Integer) return
483        Interfaces.C.Strings.chars_ptr;
484      pragma Import (C, Internal, "g_markup_escape_text");
485
486      C_Res  : constant Interfaces.C.Strings.chars_ptr :=
487        Internal (S, S'Length);
488      Result : constant String := Interfaces.C.Strings.Value (C_Res);
489
490   begin
491      g_free (C_Res);
492      return Result;
493   end Escape_Text;
494
495end Glib.Convert;
496