are_1.4.0_a458cb9e/ada-util/src/base/os-windows/util-systems-io.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
-----------------------------------------------------------------------
--  util-systems-io -- System low level and raw IO operations
--  Copyright (C) 2023 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.IO_Exceptions;
with Ada.Strings.UTF_Encoding.Strings;
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;
with System;

package body Util.Systems.IO is

   use Ada.Strings.UTF_Encoding;

   --  ------------------------------
   --  Write the Latin-1 string and encode it in UTF-8.
   --  ------------------------------
   procedure Put (File    : in File_Type;
                  Content : in String) is
      S : constant UTF_8_String := Strings.Encode (Content);
   begin
      Put_Raw (File, S);
   end Put;

   procedure Put (File    : in File_Type;
                  C       : in Character) is
      S : constant String (1 .. 1) := (others => C);
   begin
      Put (File, S);
   end Put;

   --  ------------------------------
   --  Write the string or wide character content using UTF-8 encoding.
   --  ------------------------------
   procedure Put_UTF_8 (File    : in File_Type;
                       Content : in Wide_Wide_String) is
      S : constant UTF_8_String := Wide_Wide_Strings.Encode (Content);
   begin
      Put_Raw (File, S);
   end Put_UTF_8;

   procedure Put_UTF_8 (File : in File_Type;
                        C    : in Wide_Wide_Character) is
      S : constant Wide_Wide_String (1 .. 1) := (others => C);
   begin
      Put_UTF_8 (File, S);
   end Put_UTF_8;

   --  ------------------------------
   --  Write the string considered as a sequence of bytes (no change).
   --  ------------------------------
   procedure Put_Raw (File    : in File_Type;
                      Content : in Ada.Strings.UTF_Encoding.UTF_8_String) is
      use Util.Systems.Os;
      Res    : aliased DWORD := 0;
      Status : BOOL;
   begin
      Status := Write_File (File, Content'Address, Content'Length,
                            Res'Unchecked_Access, System.Null_Address);
      if Status = 0 then
         raise Ada.IO_Exceptions.Device_Error;
      end if;
   end Put_Raw;

end Util.Systems.IO;