annotate gcc/ada/libgnat/a-stwifi.adb @ 145:1830386684a0

gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT RUN-TIME COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- A D A . S T R I N G S . W I D E _ F I X E D --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
145
1830386684a0 gcc-9.2.0
anatofuz
parents: 131
diff changeset
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- GNAT was originally developed by the GNAT team at New York University. --
kono
parents:
diff changeset
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
kono
parents:
diff changeset
29 -- --
kono
parents:
diff changeset
30 ------------------------------------------------------------------------------
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
kono
parents:
diff changeset
33 with Ada.Strings.Wide_Search;
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 package body Ada.Strings.Wide_Fixed is
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 ------------------------
kono
parents:
diff changeset
38 -- Search Subprograms --
kono
parents:
diff changeset
39 ------------------------
kono
parents:
diff changeset
40
kono
parents:
diff changeset
41 function Index
kono
parents:
diff changeset
42 (Source : Wide_String;
kono
parents:
diff changeset
43 Pattern : Wide_String;
kono
parents:
diff changeset
44 Going : Direction := Forward;
kono
parents:
diff changeset
45 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
kono
parents:
diff changeset
46 return Natural
kono
parents:
diff changeset
47 renames Ada.Strings.Wide_Search.Index;
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 function Index
kono
parents:
diff changeset
50 (Source : Wide_String;
kono
parents:
diff changeset
51 Pattern : Wide_String;
kono
parents:
diff changeset
52 Going : Direction := Forward;
kono
parents:
diff changeset
53 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
kono
parents:
diff changeset
54 renames Ada.Strings.Wide_Search.Index;
kono
parents:
diff changeset
55
kono
parents:
diff changeset
56 function Index
kono
parents:
diff changeset
57 (Source : Wide_String;
kono
parents:
diff changeset
58 Set : Wide_Maps.Wide_Character_Set;
kono
parents:
diff changeset
59 Test : Membership := Inside;
kono
parents:
diff changeset
60 Going : Direction := Forward) return Natural
kono
parents:
diff changeset
61 renames Ada.Strings.Wide_Search.Index;
kono
parents:
diff changeset
62
kono
parents:
diff changeset
63 function Index
kono
parents:
diff changeset
64 (Source : Wide_String;
kono
parents:
diff changeset
65 Pattern : Wide_String;
kono
parents:
diff changeset
66 From : Positive;
kono
parents:
diff changeset
67 Going : Direction := Forward;
kono
parents:
diff changeset
68 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
kono
parents:
diff changeset
69 return Natural
kono
parents:
diff changeset
70 renames Ada.Strings.Wide_Search.Index;
kono
parents:
diff changeset
71
kono
parents:
diff changeset
72 function Index
kono
parents:
diff changeset
73 (Source : Wide_String;
kono
parents:
diff changeset
74 Pattern : Wide_String;
kono
parents:
diff changeset
75 From : Positive;
kono
parents:
diff changeset
76 Going : Direction := Forward;
kono
parents:
diff changeset
77 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
kono
parents:
diff changeset
78 renames Ada.Strings.Wide_Search.Index;
kono
parents:
diff changeset
79
kono
parents:
diff changeset
80 function Index
kono
parents:
diff changeset
81 (Source : Wide_String;
kono
parents:
diff changeset
82 Set : Wide_Maps.Wide_Character_Set;
kono
parents:
diff changeset
83 From : Positive;
kono
parents:
diff changeset
84 Test : Membership := Inside;
kono
parents:
diff changeset
85 Going : Direction := Forward) return Natural
kono
parents:
diff changeset
86 renames Ada.Strings.Wide_Search.Index;
kono
parents:
diff changeset
87
kono
parents:
diff changeset
88 function Index_Non_Blank
kono
parents:
diff changeset
89 (Source : Wide_String;
kono
parents:
diff changeset
90 Going : Direction := Forward) return Natural
kono
parents:
diff changeset
91 renames Ada.Strings.Wide_Search.Index_Non_Blank;
kono
parents:
diff changeset
92
kono
parents:
diff changeset
93 function Index_Non_Blank
kono
parents:
diff changeset
94 (Source : Wide_String;
kono
parents:
diff changeset
95 From : Positive;
kono
parents:
diff changeset
96 Going : Direction := Forward) return Natural
kono
parents:
diff changeset
97 renames Ada.Strings.Wide_Search.Index_Non_Blank;
kono
parents:
diff changeset
98
kono
parents:
diff changeset
99 function Count
kono
parents:
diff changeset
100 (Source : Wide_String;
kono
parents:
diff changeset
101 Pattern : Wide_String;
kono
parents:
diff changeset
102 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
kono
parents:
diff changeset
103 return Natural
kono
parents:
diff changeset
104 renames Ada.Strings.Wide_Search.Count;
kono
parents:
diff changeset
105
kono
parents:
diff changeset
106 function Count
kono
parents:
diff changeset
107 (Source : Wide_String;
kono
parents:
diff changeset
108 Pattern : Wide_String;
kono
parents:
diff changeset
109 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
kono
parents:
diff changeset
110 renames Ada.Strings.Wide_Search.Count;
kono
parents:
diff changeset
111
kono
parents:
diff changeset
112 function Count
kono
parents:
diff changeset
113 (Source : Wide_String;
kono
parents:
diff changeset
114 Set : Wide_Maps.Wide_Character_Set) return Natural
kono
parents:
diff changeset
115 renames Ada.Strings.Wide_Search.Count;
kono
parents:
diff changeset
116
kono
parents:
diff changeset
117 procedure Find_Token
kono
parents:
diff changeset
118 (Source : Wide_String;
kono
parents:
diff changeset
119 Set : Wide_Maps.Wide_Character_Set;
kono
parents:
diff changeset
120 From : Positive;
kono
parents:
diff changeset
121 Test : Membership;
kono
parents:
diff changeset
122 First : out Positive;
kono
parents:
diff changeset
123 Last : out Natural)
kono
parents:
diff changeset
124 renames Ada.Strings.Wide_Search.Find_Token;
kono
parents:
diff changeset
125
kono
parents:
diff changeset
126 procedure Find_Token
kono
parents:
diff changeset
127 (Source : Wide_String;
kono
parents:
diff changeset
128 Set : Wide_Maps.Wide_Character_Set;
kono
parents:
diff changeset
129 Test : Membership;
kono
parents:
diff changeset
130 First : out Positive;
kono
parents:
diff changeset
131 Last : out Natural)
kono
parents:
diff changeset
132 renames Ada.Strings.Wide_Search.Find_Token;
kono
parents:
diff changeset
133
kono
parents:
diff changeset
134 ---------
kono
parents:
diff changeset
135 -- "*" --
kono
parents:
diff changeset
136 ---------
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 function "*"
kono
parents:
diff changeset
139 (Left : Natural;
kono
parents:
diff changeset
140 Right : Wide_Character) return Wide_String
kono
parents:
diff changeset
141 is
kono
parents:
diff changeset
142 Result : Wide_String (1 .. Left);
kono
parents:
diff changeset
143
kono
parents:
diff changeset
144 begin
kono
parents:
diff changeset
145 for J in Result'Range loop
kono
parents:
diff changeset
146 Result (J) := Right;
kono
parents:
diff changeset
147 end loop;
kono
parents:
diff changeset
148
kono
parents:
diff changeset
149 return Result;
kono
parents:
diff changeset
150 end "*";
kono
parents:
diff changeset
151
kono
parents:
diff changeset
152 function "*"
kono
parents:
diff changeset
153 (Left : Natural;
kono
parents:
diff changeset
154 Right : Wide_String) return Wide_String
kono
parents:
diff changeset
155 is
kono
parents:
diff changeset
156 Result : Wide_String (1 .. Left * Right'Length);
kono
parents:
diff changeset
157 Ptr : Integer := 1;
kono
parents:
diff changeset
158
kono
parents:
diff changeset
159 begin
kono
parents:
diff changeset
160 for J in 1 .. Left loop
kono
parents:
diff changeset
161 Result (Ptr .. Ptr + Right'Length - 1) := Right;
kono
parents:
diff changeset
162 Ptr := Ptr + Right'Length;
kono
parents:
diff changeset
163 end loop;
kono
parents:
diff changeset
164
kono
parents:
diff changeset
165 return Result;
kono
parents:
diff changeset
166 end "*";
kono
parents:
diff changeset
167
kono
parents:
diff changeset
168 ------------
kono
parents:
diff changeset
169 -- Delete --
kono
parents:
diff changeset
170 ------------
kono
parents:
diff changeset
171
kono
parents:
diff changeset
172 function Delete
kono
parents:
diff changeset
173 (Source : Wide_String;
kono
parents:
diff changeset
174 From : Positive;
kono
parents:
diff changeset
175 Through : Natural) return Wide_String
kono
parents:
diff changeset
176 is
kono
parents:
diff changeset
177 begin
kono
parents:
diff changeset
178 if From not in Source'Range
kono
parents:
diff changeset
179 or else Through > Source'Last
kono
parents:
diff changeset
180 then
kono
parents:
diff changeset
181 raise Index_Error;
kono
parents:
diff changeset
182
kono
parents:
diff changeset
183 elsif From > Through then
kono
parents:
diff changeset
184 return Source;
kono
parents:
diff changeset
185
kono
parents:
diff changeset
186 else
kono
parents:
diff changeset
187 declare
kono
parents:
diff changeset
188 Len : constant Integer := Source'Length - (Through - From + 1);
kono
parents:
diff changeset
189 Result : constant
kono
parents:
diff changeset
190 Wide_String (Source'First .. Source'First + Len - 1) :=
kono
parents:
diff changeset
191 Source (Source'First .. From - 1) &
kono
parents:
diff changeset
192 Source (Through + 1 .. Source'Last);
kono
parents:
diff changeset
193 begin
kono
parents:
diff changeset
194 return Result;
kono
parents:
diff changeset
195 end;
kono
parents:
diff changeset
196 end if;
kono
parents:
diff changeset
197 end Delete;
kono
parents:
diff changeset
198
kono
parents:
diff changeset
199 procedure Delete
kono
parents:
diff changeset
200 (Source : in out Wide_String;
kono
parents:
diff changeset
201 From : Positive;
kono
parents:
diff changeset
202 Through : Natural;
kono
parents:
diff changeset
203 Justify : Alignment := Left;
kono
parents:
diff changeset
204 Pad : Wide_Character := Wide_Space)
kono
parents:
diff changeset
205 is
kono
parents:
diff changeset
206 begin
kono
parents:
diff changeset
207 Move (Source => Delete (Source, From, Through),
kono
parents:
diff changeset
208 Target => Source,
kono
parents:
diff changeset
209 Justify => Justify,
kono
parents:
diff changeset
210 Pad => Pad);
kono
parents:
diff changeset
211 end Delete;
kono
parents:
diff changeset
212
kono
parents:
diff changeset
213 ----------
kono
parents:
diff changeset
214 -- Head --
kono
parents:
diff changeset
215 ----------
kono
parents:
diff changeset
216
kono
parents:
diff changeset
217 function Head
kono
parents:
diff changeset
218 (Source : Wide_String;
kono
parents:
diff changeset
219 Count : Natural;
kono
parents:
diff changeset
220 Pad : Wide_Character := Wide_Space) return Wide_String
kono
parents:
diff changeset
221 is
kono
parents:
diff changeset
222 Result : Wide_String (1 .. Count);
kono
parents:
diff changeset
223
kono
parents:
diff changeset
224 begin
kono
parents:
diff changeset
225 if Count <= Source'Length then
kono
parents:
diff changeset
226 Result := Source (Source'First .. Source'First + Count - 1);
kono
parents:
diff changeset
227
kono
parents:
diff changeset
228 else
kono
parents:
diff changeset
229 Result (1 .. Source'Length) := Source;
kono
parents:
diff changeset
230
kono
parents:
diff changeset
231 for J in Source'Length + 1 .. Count loop
kono
parents:
diff changeset
232 Result (J) := Pad;
kono
parents:
diff changeset
233 end loop;
kono
parents:
diff changeset
234 end if;
kono
parents:
diff changeset
235
kono
parents:
diff changeset
236 return Result;
kono
parents:
diff changeset
237 end Head;
kono
parents:
diff changeset
238
kono
parents:
diff changeset
239 procedure Head
kono
parents:
diff changeset
240 (Source : in out Wide_String;
kono
parents:
diff changeset
241 Count : Natural;
kono
parents:
diff changeset
242 Justify : Alignment := Left;
kono
parents:
diff changeset
243 Pad : Wide_Character := Ada.Strings.Wide_Space)
kono
parents:
diff changeset
244 is
kono
parents:
diff changeset
245 begin
kono
parents:
diff changeset
246 Move (Source => Head (Source, Count, Pad),
kono
parents:
diff changeset
247 Target => Source,
kono
parents:
diff changeset
248 Drop => Error,
kono
parents:
diff changeset
249 Justify => Justify,
kono
parents:
diff changeset
250 Pad => Pad);
kono
parents:
diff changeset
251 end Head;
kono
parents:
diff changeset
252
kono
parents:
diff changeset
253 ------------
kono
parents:
diff changeset
254 -- Insert --
kono
parents:
diff changeset
255 ------------
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 function Insert
kono
parents:
diff changeset
258 (Source : Wide_String;
kono
parents:
diff changeset
259 Before : Positive;
kono
parents:
diff changeset
260 New_Item : Wide_String) return Wide_String
kono
parents:
diff changeset
261 is
kono
parents:
diff changeset
262 Result : Wide_String (1 .. Source'Length + New_Item'Length);
kono
parents:
diff changeset
263
kono
parents:
diff changeset
264 begin
kono
parents:
diff changeset
265 if Before < Source'First or else Before > Source'Last + 1 then
kono
parents:
diff changeset
266 raise Index_Error;
kono
parents:
diff changeset
267 end if;
kono
parents:
diff changeset
268
kono
parents:
diff changeset
269 Result := Source (Source'First .. Before - 1) & New_Item &
kono
parents:
diff changeset
270 Source (Before .. Source'Last);
kono
parents:
diff changeset
271 return Result;
kono
parents:
diff changeset
272 end Insert;
kono
parents:
diff changeset
273
kono
parents:
diff changeset
274 procedure Insert
kono
parents:
diff changeset
275 (Source : in out Wide_String;
kono
parents:
diff changeset
276 Before : Positive;
kono
parents:
diff changeset
277 New_Item : Wide_String;
kono
parents:
diff changeset
278 Drop : Truncation := Error)
kono
parents:
diff changeset
279 is
kono
parents:
diff changeset
280 begin
kono
parents:
diff changeset
281 Move (Source => Insert (Source, Before, New_Item),
kono
parents:
diff changeset
282 Target => Source,
kono
parents:
diff changeset
283 Drop => Drop);
kono
parents:
diff changeset
284 end Insert;
kono
parents:
diff changeset
285
kono
parents:
diff changeset
286 ----------
kono
parents:
diff changeset
287 -- Move --
kono
parents:
diff changeset
288 ----------
kono
parents:
diff changeset
289
kono
parents:
diff changeset
290 procedure Move
kono
parents:
diff changeset
291 (Source : Wide_String;
kono
parents:
diff changeset
292 Target : out Wide_String;
kono
parents:
diff changeset
293 Drop : Truncation := Error;
kono
parents:
diff changeset
294 Justify : Alignment := Left;
kono
parents:
diff changeset
295 Pad : Wide_Character := Wide_Space)
kono
parents:
diff changeset
296 is
kono
parents:
diff changeset
297 Sfirst : constant Integer := Source'First;
kono
parents:
diff changeset
298 Slast : constant Integer := Source'Last;
kono
parents:
diff changeset
299 Slength : constant Integer := Source'Length;
kono
parents:
diff changeset
300
kono
parents:
diff changeset
301 Tfirst : constant Integer := Target'First;
kono
parents:
diff changeset
302 Tlast : constant Integer := Target'Last;
kono
parents:
diff changeset
303 Tlength : constant Integer := Target'Length;
kono
parents:
diff changeset
304
kono
parents:
diff changeset
305 function Is_Padding (Item : Wide_String) return Boolean;
kono
parents:
diff changeset
306 -- Determine if all characters in Item are pad characters
kono
parents:
diff changeset
307
kono
parents:
diff changeset
308 ----------------
kono
parents:
diff changeset
309 -- Is_Padding --
kono
parents:
diff changeset
310 ----------------
kono
parents:
diff changeset
311
kono
parents:
diff changeset
312 function Is_Padding (Item : Wide_String) return Boolean is
kono
parents:
diff changeset
313 begin
kono
parents:
diff changeset
314 for J in Item'Range loop
kono
parents:
diff changeset
315 if Item (J) /= Pad then
kono
parents:
diff changeset
316 return False;
kono
parents:
diff changeset
317 end if;
kono
parents:
diff changeset
318 end loop;
kono
parents:
diff changeset
319
kono
parents:
diff changeset
320 return True;
kono
parents:
diff changeset
321 end Is_Padding;
kono
parents:
diff changeset
322
kono
parents:
diff changeset
323 -- Start of processing for Move
kono
parents:
diff changeset
324
kono
parents:
diff changeset
325 begin
kono
parents:
diff changeset
326 if Slength = Tlength then
kono
parents:
diff changeset
327 Target := Source;
kono
parents:
diff changeset
328
kono
parents:
diff changeset
329 elsif Slength > Tlength then
kono
parents:
diff changeset
330 case Drop is
kono
parents:
diff changeset
331 when Left =>
kono
parents:
diff changeset
332 Target := Source (Slast - Tlength + 1 .. Slast);
kono
parents:
diff changeset
333
kono
parents:
diff changeset
334 when Right =>
kono
parents:
diff changeset
335 Target := Source (Sfirst .. Sfirst + Tlength - 1);
kono
parents:
diff changeset
336
kono
parents:
diff changeset
337 when Error =>
kono
parents:
diff changeset
338 case Justify is
kono
parents:
diff changeset
339 when Left =>
kono
parents:
diff changeset
340 if Is_Padding (Source (Sfirst + Tlength .. Slast)) then
kono
parents:
diff changeset
341 Target :=
kono
parents:
diff changeset
342 Source (Sfirst .. Sfirst + Target'Length - 1);
kono
parents:
diff changeset
343 else
kono
parents:
diff changeset
344 raise Length_Error;
kono
parents:
diff changeset
345 end if;
kono
parents:
diff changeset
346
kono
parents:
diff changeset
347 when Right =>
kono
parents:
diff changeset
348 if Is_Padding (Source (Sfirst .. Slast - Tlength)) then
kono
parents:
diff changeset
349 Target := Source (Slast - Tlength + 1 .. Slast);
kono
parents:
diff changeset
350 else
kono
parents:
diff changeset
351 raise Length_Error;
kono
parents:
diff changeset
352 end if;
kono
parents:
diff changeset
353
kono
parents:
diff changeset
354 when Center =>
kono
parents:
diff changeset
355 raise Length_Error;
kono
parents:
diff changeset
356 end case;
kono
parents:
diff changeset
357 end case;
kono
parents:
diff changeset
358
kono
parents:
diff changeset
359 -- Source'Length < Target'Length
kono
parents:
diff changeset
360
kono
parents:
diff changeset
361 else
kono
parents:
diff changeset
362 case Justify is
kono
parents:
diff changeset
363 when Left =>
kono
parents:
diff changeset
364 Target (Tfirst .. Tfirst + Slength - 1) := Source;
kono
parents:
diff changeset
365
kono
parents:
diff changeset
366 for J in Tfirst + Slength .. Tlast loop
kono
parents:
diff changeset
367 Target (J) := Pad;
kono
parents:
diff changeset
368 end loop;
kono
parents:
diff changeset
369
kono
parents:
diff changeset
370 when Right =>
kono
parents:
diff changeset
371 for J in Tfirst .. Tlast - Slength loop
kono
parents:
diff changeset
372 Target (J) := Pad;
kono
parents:
diff changeset
373 end loop;
kono
parents:
diff changeset
374
kono
parents:
diff changeset
375 Target (Tlast - Slength + 1 .. Tlast) := Source;
kono
parents:
diff changeset
376
kono
parents:
diff changeset
377 when Center =>
kono
parents:
diff changeset
378 declare
kono
parents:
diff changeset
379 Front_Pad : constant Integer := (Tlength - Slength) / 2;
kono
parents:
diff changeset
380 Tfirst_Fpad : constant Integer := Tfirst + Front_Pad;
kono
parents:
diff changeset
381
kono
parents:
diff changeset
382 begin
kono
parents:
diff changeset
383 for J in Tfirst .. Tfirst_Fpad - 1 loop
kono
parents:
diff changeset
384 Target (J) := Pad;
kono
parents:
diff changeset
385 end loop;
kono
parents:
diff changeset
386
kono
parents:
diff changeset
387 Target (Tfirst_Fpad .. Tfirst_Fpad + Slength - 1) := Source;
kono
parents:
diff changeset
388
kono
parents:
diff changeset
389 for J in Tfirst_Fpad + Slength .. Tlast loop
kono
parents:
diff changeset
390 Target (J) := Pad;
kono
parents:
diff changeset
391 end loop;
kono
parents:
diff changeset
392 end;
kono
parents:
diff changeset
393 end case;
kono
parents:
diff changeset
394 end if;
kono
parents:
diff changeset
395 end Move;
kono
parents:
diff changeset
396
kono
parents:
diff changeset
397 ---------------
kono
parents:
diff changeset
398 -- Overwrite --
kono
parents:
diff changeset
399 ---------------
kono
parents:
diff changeset
400
kono
parents:
diff changeset
401 function Overwrite
kono
parents:
diff changeset
402 (Source : Wide_String;
kono
parents:
diff changeset
403 Position : Positive;
kono
parents:
diff changeset
404 New_Item : Wide_String) return Wide_String
kono
parents:
diff changeset
405 is
kono
parents:
diff changeset
406 begin
kono
parents:
diff changeset
407 if Position not in Source'First .. Source'Last + 1 then
kono
parents:
diff changeset
408 raise Index_Error;
kono
parents:
diff changeset
409 else
kono
parents:
diff changeset
410 declare
kono
parents:
diff changeset
411 Result_Length : constant Natural :=
kono
parents:
diff changeset
412 Natural'Max
kono
parents:
diff changeset
413 (Source'Length,
kono
parents:
diff changeset
414 Position - Source'First + New_Item'Length);
kono
parents:
diff changeset
415
kono
parents:
diff changeset
416 Result : Wide_String (1 .. Result_Length);
kono
parents:
diff changeset
417
kono
parents:
diff changeset
418 begin
kono
parents:
diff changeset
419 Result := Source (Source'First .. Position - 1) & New_Item &
kono
parents:
diff changeset
420 Source (Position + New_Item'Length .. Source'Last);
kono
parents:
diff changeset
421 return Result;
kono
parents:
diff changeset
422 end;
kono
parents:
diff changeset
423 end if;
kono
parents:
diff changeset
424 end Overwrite;
kono
parents:
diff changeset
425
kono
parents:
diff changeset
426 procedure Overwrite
kono
parents:
diff changeset
427 (Source : in out Wide_String;
kono
parents:
diff changeset
428 Position : Positive;
kono
parents:
diff changeset
429 New_Item : Wide_String;
kono
parents:
diff changeset
430 Drop : Truncation := Right)
kono
parents:
diff changeset
431 is
kono
parents:
diff changeset
432 begin
kono
parents:
diff changeset
433 Move (Source => Overwrite (Source, Position, New_Item),
kono
parents:
diff changeset
434 Target => Source,
kono
parents:
diff changeset
435 Drop => Drop);
kono
parents:
diff changeset
436 end Overwrite;
kono
parents:
diff changeset
437
kono
parents:
diff changeset
438 -------------------
kono
parents:
diff changeset
439 -- Replace_Slice --
kono
parents:
diff changeset
440 -------------------
kono
parents:
diff changeset
441
kono
parents:
diff changeset
442 function Replace_Slice
kono
parents:
diff changeset
443 (Source : Wide_String;
kono
parents:
diff changeset
444 Low : Positive;
kono
parents:
diff changeset
445 High : Natural;
kono
parents:
diff changeset
446 By : Wide_String) return Wide_String
kono
parents:
diff changeset
447 is
kono
parents:
diff changeset
448 begin
kono
parents:
diff changeset
449 if Low > Source'Last + 1 or else High < Source'First - 1 then
kono
parents:
diff changeset
450 raise Index_Error;
kono
parents:
diff changeset
451 end if;
kono
parents:
diff changeset
452
kono
parents:
diff changeset
453 if High >= Low then
kono
parents:
diff changeset
454 declare
kono
parents:
diff changeset
455 Front_Len : constant Integer :=
kono
parents:
diff changeset
456 Integer'Max (0, Low - Source'First);
kono
parents:
diff changeset
457 -- Length of prefix of Source copied to result
kono
parents:
diff changeset
458
kono
parents:
diff changeset
459 Back_Len : constant Integer := Integer'Max (0, Source'Last - High);
kono
parents:
diff changeset
460 -- Length of suffix of Source copied to result
kono
parents:
diff changeset
461
kono
parents:
diff changeset
462 Result_Length : constant Integer :=
kono
parents:
diff changeset
463 Front_Len + By'Length + Back_Len;
kono
parents:
diff changeset
464 -- Length of result
kono
parents:
diff changeset
465
kono
parents:
diff changeset
466 Result : Wide_String (1 .. Result_Length);
kono
parents:
diff changeset
467
kono
parents:
diff changeset
468 begin
kono
parents:
diff changeset
469 Result (1 .. Front_Len) := Source (Source'First .. Low - 1);
kono
parents:
diff changeset
470 Result (Front_Len + 1 .. Front_Len + By'Length) := By;
kono
parents:
diff changeset
471 Result (Front_Len + By'Length + 1 .. Result'Length) :=
kono
parents:
diff changeset
472 Source (High + 1 .. Source'Last);
kono
parents:
diff changeset
473 return Result;
kono
parents:
diff changeset
474 end;
kono
parents:
diff changeset
475
kono
parents:
diff changeset
476 else
kono
parents:
diff changeset
477 return Insert (Source, Before => Low, New_Item => By);
kono
parents:
diff changeset
478 end if;
kono
parents:
diff changeset
479 end Replace_Slice;
kono
parents:
diff changeset
480
kono
parents:
diff changeset
481 procedure Replace_Slice
kono
parents:
diff changeset
482 (Source : in out Wide_String;
kono
parents:
diff changeset
483 Low : Positive;
kono
parents:
diff changeset
484 High : Natural;
kono
parents:
diff changeset
485 By : Wide_String;
kono
parents:
diff changeset
486 Drop : Truncation := Error;
kono
parents:
diff changeset
487 Justify : Alignment := Left;
kono
parents:
diff changeset
488 Pad : Wide_Character := Wide_Space)
kono
parents:
diff changeset
489 is
kono
parents:
diff changeset
490 begin
kono
parents:
diff changeset
491 Move (Replace_Slice (Source, Low, High, By), Source, Drop, Justify, Pad);
kono
parents:
diff changeset
492 end Replace_Slice;
kono
parents:
diff changeset
493
kono
parents:
diff changeset
494 ----------
kono
parents:
diff changeset
495 -- Tail --
kono
parents:
diff changeset
496 ----------
kono
parents:
diff changeset
497
kono
parents:
diff changeset
498 function Tail
kono
parents:
diff changeset
499 (Source : Wide_String;
kono
parents:
diff changeset
500 Count : Natural;
kono
parents:
diff changeset
501 Pad : Wide_Character := Wide_Space) return Wide_String
kono
parents:
diff changeset
502 is
kono
parents:
diff changeset
503 Result : Wide_String (1 .. Count);
kono
parents:
diff changeset
504
kono
parents:
diff changeset
505 begin
kono
parents:
diff changeset
506 if Count < Source'Length then
kono
parents:
diff changeset
507 Result := Source (Source'Last - Count + 1 .. Source'Last);
kono
parents:
diff changeset
508
kono
parents:
diff changeset
509 -- Pad on left
kono
parents:
diff changeset
510
kono
parents:
diff changeset
511 else
kono
parents:
diff changeset
512 for J in 1 .. Count - Source'Length loop
kono
parents:
diff changeset
513 Result (J) := Pad;
kono
parents:
diff changeset
514 end loop;
kono
parents:
diff changeset
515
kono
parents:
diff changeset
516 Result (Count - Source'Length + 1 .. Count) := Source;
kono
parents:
diff changeset
517 end if;
kono
parents:
diff changeset
518
kono
parents:
diff changeset
519 return Result;
kono
parents:
diff changeset
520 end Tail;
kono
parents:
diff changeset
521
kono
parents:
diff changeset
522 procedure Tail
kono
parents:
diff changeset
523 (Source : in out Wide_String;
kono
parents:
diff changeset
524 Count : Natural;
kono
parents:
diff changeset
525 Justify : Alignment := Left;
kono
parents:
diff changeset
526 Pad : Wide_Character := Ada.Strings.Wide_Space)
kono
parents:
diff changeset
527 is
kono
parents:
diff changeset
528 begin
kono
parents:
diff changeset
529 Move (Source => Tail (Source, Count, Pad),
kono
parents:
diff changeset
530 Target => Source,
kono
parents:
diff changeset
531 Drop => Error,
kono
parents:
diff changeset
532 Justify => Justify,
kono
parents:
diff changeset
533 Pad => Pad);
kono
parents:
diff changeset
534 end Tail;
kono
parents:
diff changeset
535
kono
parents:
diff changeset
536 ---------------
kono
parents:
diff changeset
537 -- Translate --
kono
parents:
diff changeset
538 ---------------
kono
parents:
diff changeset
539
kono
parents:
diff changeset
540 function Translate
kono
parents:
diff changeset
541 (Source : Wide_String;
kono
parents:
diff changeset
542 Mapping : Wide_Maps.Wide_Character_Mapping) return Wide_String
kono
parents:
diff changeset
543 is
kono
parents:
diff changeset
544 Result : Wide_String (1 .. Source'Length);
kono
parents:
diff changeset
545
kono
parents:
diff changeset
546 begin
kono
parents:
diff changeset
547 for J in Source'Range loop
kono
parents:
diff changeset
548 Result (J - (Source'First - 1)) := Value (Mapping, Source (J));
kono
parents:
diff changeset
549 end loop;
kono
parents:
diff changeset
550
kono
parents:
diff changeset
551 return Result;
kono
parents:
diff changeset
552 end Translate;
kono
parents:
diff changeset
553
kono
parents:
diff changeset
554 procedure Translate
kono
parents:
diff changeset
555 (Source : in out Wide_String;
kono
parents:
diff changeset
556 Mapping : Wide_Maps.Wide_Character_Mapping)
kono
parents:
diff changeset
557 is
kono
parents:
diff changeset
558 begin
kono
parents:
diff changeset
559 for J in Source'Range loop
kono
parents:
diff changeset
560 Source (J) := Value (Mapping, Source (J));
kono
parents:
diff changeset
561 end loop;
kono
parents:
diff changeset
562 end Translate;
kono
parents:
diff changeset
563
kono
parents:
diff changeset
564 function Translate
kono
parents:
diff changeset
565 (Source : Wide_String;
kono
parents:
diff changeset
566 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Wide_String
kono
parents:
diff changeset
567 is
kono
parents:
diff changeset
568 Result : Wide_String (1 .. Source'Length);
kono
parents:
diff changeset
569
kono
parents:
diff changeset
570 begin
kono
parents:
diff changeset
571 for J in Source'Range loop
kono
parents:
diff changeset
572 Result (J - (Source'First - 1)) := Mapping (Source (J));
kono
parents:
diff changeset
573 end loop;
kono
parents:
diff changeset
574
kono
parents:
diff changeset
575 return Result;
kono
parents:
diff changeset
576 end Translate;
kono
parents:
diff changeset
577
kono
parents:
diff changeset
578 procedure Translate
kono
parents:
diff changeset
579 (Source : in out Wide_String;
kono
parents:
diff changeset
580 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
kono
parents:
diff changeset
581 is
kono
parents:
diff changeset
582 begin
kono
parents:
diff changeset
583 for J in Source'Range loop
kono
parents:
diff changeset
584 Source (J) := Mapping (Source (J));
kono
parents:
diff changeset
585 end loop;
kono
parents:
diff changeset
586 end Translate;
kono
parents:
diff changeset
587
kono
parents:
diff changeset
588 ----------
kono
parents:
diff changeset
589 -- Trim --
kono
parents:
diff changeset
590 ----------
kono
parents:
diff changeset
591
kono
parents:
diff changeset
592 function Trim
kono
parents:
diff changeset
593 (Source : Wide_String;
kono
parents:
diff changeset
594 Side : Trim_End) return Wide_String
kono
parents:
diff changeset
595 is
kono
parents:
diff changeset
596 Low : Natural := Source'First;
kono
parents:
diff changeset
597 High : Natural := Source'Last;
kono
parents:
diff changeset
598
kono
parents:
diff changeset
599 begin
kono
parents:
diff changeset
600 if Side = Left or else Side = Both then
kono
parents:
diff changeset
601 while Low <= High and then Source (Low) = Wide_Space loop
kono
parents:
diff changeset
602 Low := Low + 1;
kono
parents:
diff changeset
603 end loop;
kono
parents:
diff changeset
604 end if;
kono
parents:
diff changeset
605
kono
parents:
diff changeset
606 if Side = Right or else Side = Both then
kono
parents:
diff changeset
607 while High >= Low and then Source (High) = Wide_Space loop
kono
parents:
diff changeset
608 High := High - 1;
kono
parents:
diff changeset
609 end loop;
kono
parents:
diff changeset
610 end if;
kono
parents:
diff changeset
611
kono
parents:
diff changeset
612 -- All blanks case
kono
parents:
diff changeset
613
kono
parents:
diff changeset
614 if Low > High then
kono
parents:
diff changeset
615 return "";
kono
parents:
diff changeset
616
kono
parents:
diff changeset
617 -- At least one non-blank
kono
parents:
diff changeset
618
kono
parents:
diff changeset
619 else
kono
parents:
diff changeset
620 declare
kono
parents:
diff changeset
621 Result : constant Wide_String (1 .. High - Low + 1) :=
kono
parents:
diff changeset
622 Source (Low .. High);
kono
parents:
diff changeset
623
kono
parents:
diff changeset
624 begin
kono
parents:
diff changeset
625 return Result;
kono
parents:
diff changeset
626 end;
kono
parents:
diff changeset
627 end if;
kono
parents:
diff changeset
628 end Trim;
kono
parents:
diff changeset
629
kono
parents:
diff changeset
630 procedure Trim
kono
parents:
diff changeset
631 (Source : in out Wide_String;
kono
parents:
diff changeset
632 Side : Trim_End;
kono
parents:
diff changeset
633 Justify : Alignment := Left;
kono
parents:
diff changeset
634 Pad : Wide_Character := Wide_Space)
kono
parents:
diff changeset
635 is
kono
parents:
diff changeset
636 begin
kono
parents:
diff changeset
637 Move (Source => Trim (Source, Side),
kono
parents:
diff changeset
638 Target => Source,
kono
parents:
diff changeset
639 Justify => Justify,
kono
parents:
diff changeset
640 Pad => Pad);
kono
parents:
diff changeset
641 end Trim;
kono
parents:
diff changeset
642
kono
parents:
diff changeset
643 function Trim
kono
parents:
diff changeset
644 (Source : Wide_String;
kono
parents:
diff changeset
645 Left : Wide_Maps.Wide_Character_Set;
kono
parents:
diff changeset
646 Right : Wide_Maps.Wide_Character_Set) return Wide_String
kono
parents:
diff changeset
647 is
kono
parents:
diff changeset
648 Low : Natural := Source'First;
kono
parents:
diff changeset
649 High : Natural := Source'Last;
kono
parents:
diff changeset
650
kono
parents:
diff changeset
651 begin
kono
parents:
diff changeset
652 while Low <= High and then Is_In (Source (Low), Left) loop
kono
parents:
diff changeset
653 Low := Low + 1;
kono
parents:
diff changeset
654 end loop;
kono
parents:
diff changeset
655
kono
parents:
diff changeset
656 while High >= Low and then Is_In (Source (High), Right) loop
kono
parents:
diff changeset
657 High := High - 1;
kono
parents:
diff changeset
658 end loop;
kono
parents:
diff changeset
659
kono
parents:
diff changeset
660 -- Case where source comprises only characters in the sets
kono
parents:
diff changeset
661
kono
parents:
diff changeset
662 if Low > High then
kono
parents:
diff changeset
663 return "";
kono
parents:
diff changeset
664 else
kono
parents:
diff changeset
665 declare
kono
parents:
diff changeset
666 subtype WS is Wide_String (1 .. High - Low + 1);
kono
parents:
diff changeset
667
kono
parents:
diff changeset
668 begin
kono
parents:
diff changeset
669 return WS (Source (Low .. High));
kono
parents:
diff changeset
670 end;
kono
parents:
diff changeset
671 end if;
kono
parents:
diff changeset
672 end Trim;
kono
parents:
diff changeset
673
kono
parents:
diff changeset
674 procedure Trim
kono
parents:
diff changeset
675 (Source : in out Wide_String;
kono
parents:
diff changeset
676 Left : Wide_Maps.Wide_Character_Set;
kono
parents:
diff changeset
677 Right : Wide_Maps.Wide_Character_Set;
kono
parents:
diff changeset
678 Justify : Alignment := Strings.Left;
kono
parents:
diff changeset
679 Pad : Wide_Character := Wide_Space)
kono
parents:
diff changeset
680 is
kono
parents:
diff changeset
681 begin
kono
parents:
diff changeset
682 Move (Source => Trim (Source, Left, Right),
kono
parents:
diff changeset
683 Target => Source,
kono
parents:
diff changeset
684 Justify => Justify,
kono
parents:
diff changeset
685 Pad => Pad);
kono
parents:
diff changeset
686 end Trim;
kono
parents:
diff changeset
687
kono
parents:
diff changeset
688 end Ada.Strings.Wide_Fixed;