1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- S Y S T E M . W C H _ S T W --
9 -- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Interfaces
; use Interfaces
;
35 with System
.WCh_Con
; use System
.WCh_Con
;
36 with System
.WCh_JIS
; use System
.WCh_JIS
;
38 package body System
.WCh_StW
is
40 ---------------------------
41 -- String_To_Wide_String --
42 ---------------------------
44 function String_To_Wide_String
46 EM
: WC_Encoding_Method
)
49 R
: Wide_String (1 .. S
'Length);
57 Last
: constant Natural := S
'Last;
59 function Get_Hex
(C
: Character) return Unsigned_16
;
60 -- Converts character from hex digit to value in range 0-15. The
61 -- input must be in 0-9, A-F, or a-f, and no check is needed.
64 -- Translates four hex characters starting at S (SP) to a single
65 -- wide character. Used in WCEM_Hex and WCEM_Brackets mode. SP
66 -- is not modified by the call. The resulting wide character value
67 -- is stored in R (RP). RP is not modified by the call.
69 function Get_Hex
(C
: Character) return Unsigned_16
is
71 if C
in '0' .. '9' then
72 return Character'Pos (C
) - Character'Pos ('0');
73 elsif C
in 'A' .. 'F' then
74 return Character'Pos (C
) - Character'Pos ('A') + 10;
76 return Character'Pos (C
) - Character'Pos ('a') + 10;
80 procedure Get_Hex_4
is
82 R
(RP
) := Wide_Character'Val (
83 Get_Hex
(S
(SP
+ 3)) + 16 *
84 (Get_Hex
(S
(SP
+ 2)) + 16 *
85 (Get_Hex
(S
(SP
+ 1)) + 16 *
86 (Get_Hex
(S
(SP
+ 0))))));
89 -- Start of processing for String_To_Wide_String
97 -- ESC-Hex representation
100 while SP
<= Last
- 4 loop
103 if S
(SP
) = ASCII
.ESC
then
108 R
(RP
) := Wide_Character'Val (Character'Pos (S
(SP
)));
113 -- Upper bit shift, internal code = external code
119 if S
(SP
) >= Character'Val (16#
80#
) then
120 U1
:= Character'Pos (S
(SP
));
121 U2
:= Character'Pos (S
(SP
+ 1));
122 R
(RP
) := Wide_Character'Val (256 * U1
+ U2
);
125 R
(RP
) := Wide_Character'Val (Character'Pos (S
(SP
)));
130 -- Upper bit shift, shift-JIS
132 when WCEM_Shift_JIS
=>
136 if S
(SP
) >= Character'Val (16#
80#
) then
137 R
(RP
) := Shift_JIS_To_JIS
(S
(SP
), S
(SP
+ 1));
140 R
(RP
) := Wide_Character'Val (Character'Pos (S
(SP
)));
145 -- Upper bit shift, EUC
151 if S
(SP
) >= Character'Val (16#
80#
) then
152 R
(RP
) := EUC_To_JIS
(S
(SP
), S
(SP
+ 1));
155 R
(RP
) := Wide_Character'Val (Character'Pos (S
(SP
)));
160 -- Upper bit shift, UTF-8
166 if S
(SP
) >= Character'Val (16#
80#
) then
167 U1
:= Character'Pos (S
(SP
));
168 U2
:= Character'Pos (S
(SP
+ 1));
170 U
:= Shift_Left
(U1
and 2#
00011111#
, 6) +
171 (U2
and 2#
00111111#
);
174 if U1
>= 2#
11100000#
then
175 U3
:= Character'Pos (S
(SP
));
176 U
:= Shift_Left
(U
, 6) + (U3
and 2#
00111111#
);
180 R
(RP
) := Wide_Character'Val (U
);
183 R
(RP
) := Wide_Character'Val (Character'Pos (S
(SP
)));
188 -- Brackets representation
190 when WCEM_Brackets
=>
191 while SP
<= Last
- 7 loop
195 and then S
(SP
+ 1) = '"'
196 and then S
(SP
+ 2) /= '"'
203 R
(RP
) := Wide_Character'Val (Character'Pos (S
(SP
)));
210 while SP
<= Last
loop
212 R
(RP
) := Wide_Character'Val (Character'Pos (S
(SP
)));
217 end String_To_Wide_String
;