1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . S T R I N G S . W I D E _ F I X E D --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 with Ada
.Strings
.Wide_Maps
; use Ada
.Strings
.Wide_Maps
;
36 with Ada
.Strings
.Wide_Search
;
38 package body Ada
.Strings
.Wide_Fixed
is
40 ------------------------
41 -- Search Subprograms --
42 ------------------------
45 (Source
: in Wide_String;
46 Pattern
: in Wide_String;
47 Going
: in Direction
:= Forward
;
48 Mapping
: in Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
50 renames Ada
.Strings
.Wide_Search
.Index
;
53 (Source
: in Wide_String;
54 Pattern
: in Wide_String;
55 Going
: in Direction
:= Forward
;
56 Mapping
: in Wide_Maps
.Wide_Character_Mapping_Function
)
58 renames Ada
.Strings
.Wide_Search
.Index
;
61 (Source
: in Wide_String;
62 Set
: in Wide_Maps
.Wide_Character_Set
;
63 Test
: in Membership
:= Inside
;
64 Going
: in Direction
:= Forward
)
66 renames Ada
.Strings
.Wide_Search
.Index
;
68 function Index_Non_Blank
69 (Source
: in Wide_String;
70 Going
: in Direction
:= Forward
)
72 renames Ada
.Strings
.Wide_Search
.Index_Non_Blank
;
75 (Source
: in Wide_String;
76 Pattern
: in Wide_String;
77 Mapping
: in Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
79 renames Ada
.Strings
.Wide_Search
.Count
;
82 (Source
: in Wide_String;
83 Pattern
: in Wide_String;
84 Mapping
: in Wide_Maps
.Wide_Character_Mapping_Function
)
86 renames Ada
.Strings
.Wide_Search
.Count
;
89 (Source
: in Wide_String;
90 Set
: in Wide_Maps
.Wide_Character_Set
)
92 renames Ada
.Strings
.Wide_Search
.Count
;
95 (Source
: in Wide_String;
96 Set
: in Wide_Maps
.Wide_Character_Set
;
100 renames Ada
.Strings
.Wide_Search
.Find_Token
;
108 Right
: in Wide_Character)
111 Result
: Wide_String (1 .. Left
);
114 for J
in Result
'Range loop
123 Right
: in Wide_String)
126 Result
: Wide_String (1 .. Left
* Right
'Length);
130 for J
in 1 .. Left
loop
131 Result
(Ptr
.. Ptr
+ Right
'Length - 1) := Right
;
132 Ptr
:= Ptr
+ Right
'Length;
143 (Source
: in Wide_String;
145 Through
: in Natural)
149 if From
not in Source
'Range
150 or else Through
> Source
'Last
154 elsif From
> Through
then
159 Len
: constant Integer := Source
'Length - (Through
- From
+ 1);
161 Wide_String (Source
'First .. Source
'First + Len
- 1) :=
162 Source
(Source
'First .. From
- 1) &
163 Source
(Through
+ 1 .. Source
'Last);
171 (Source
: in out Wide_String;
173 Through
: in Natural;
174 Justify
: in Alignment
:= Left
;
175 Pad
: in Wide_Character := Wide_Space
)
178 Move
(Source
=> Delete
(Source
, From
, Through
),
189 (Source
: in Wide_String;
191 Pad
: in Wide_Character := Wide_Space
)
194 Result
: Wide_String (1 .. Count
);
197 if Count
<= Source
'Length then
198 Result
:= Source
(Source
'First .. Source
'First + Count
- 1);
201 Result
(1 .. Source
'Length) := Source
;
203 for J
in Source
'Length + 1 .. Count
loop
212 (Source
: in out Wide_String;
214 Justify
: in Alignment
:= Left
;
215 Pad
: in Wide_Character := Ada
.Strings
.Wide_Space
)
218 Move
(Source
=> Head
(Source
, Count
, Pad
),
230 (Source
: in Wide_String;
231 Before
: in Positive;
232 New_Item
: in Wide_String)
235 Result
: Wide_String (1 .. Source
'Length + New_Item
'Length);
238 if Before
< Source
'First or else Before
> Source
'Last + 1 then
242 Result
:= Source
(Source
'First .. Before
- 1) & New_Item
&
243 Source
(Before
.. Source
'Last);
248 (Source
: in out Wide_String;
249 Before
: in Positive;
250 New_Item
: in Wide_String;
251 Drop
: in Truncation
:= Error
)
254 Move
(Source
=> Insert
(Source
, Before
, New_Item
),
264 (Source
: in Wide_String;
265 Target
: out Wide_String;
266 Drop
: in Truncation
:= Error
;
267 Justify
: in Alignment
:= Left
;
268 Pad
: in Wide_Character := Wide_Space
)
270 Sfirst
: constant Integer := Source
'First;
271 Slast
: constant Integer := Source
'Last;
272 Slength
: constant Integer := Source
'Length;
274 Tfirst
: constant Integer := Target
'First;
275 Tlast
: constant Integer := Target
'Last;
276 Tlength
: constant Integer := Target
'Length;
278 function Is_Padding
(Item
: Wide_String) return Boolean;
279 -- Determinbe if all characters in Item are pad characters
281 function Is_Padding
(Item
: Wide_String) return Boolean is
283 for J
in Item
'Range loop
284 if Item
(J
) /= Pad
then
292 -- Start of processing for Move
295 if Slength
= Tlength
then
298 elsif Slength
> Tlength
then
302 Target
:= Source
(Slast
- Tlength
+ 1 .. Slast
);
305 Target
:= Source
(Sfirst
.. Sfirst
+ Tlength
- 1);
310 if Is_Padding
(Source
(Sfirst
+ Tlength
.. Slast
)) then
312 Source
(Sfirst
.. Sfirst
+ Target
'Length - 1);
318 if Is_Padding
(Source
(Sfirst
.. Slast
- Tlength
)) then
319 Target
:= Source
(Slast
- Tlength
+ 1 .. Slast
);
330 -- Source'Length < Target'Length
335 Target
(Tfirst
.. Tfirst
+ Slength
- 1) := Source
;
337 for J
in Tfirst
+ Slength
.. Tlast
loop
342 for J
in Tfirst
.. Tlast
- Slength
loop
346 Target
(Tlast
- Slength
+ 1 .. Tlast
) := Source
;
350 Front_Pad
: constant Integer := (Tlength
- Slength
) / 2;
351 Tfirst_Fpad
: constant Integer := Tfirst
+ Front_Pad
;
354 for J
in Tfirst
.. Tfirst_Fpad
- 1 loop
358 Target
(Tfirst_Fpad
.. Tfirst_Fpad
+ Slength
- 1) := Source
;
360 for J
in Tfirst_Fpad
+ Slength
.. Tlast
loop
373 (Source
: in Wide_String;
374 Position
: in Positive;
375 New_Item
: in Wide_String)
379 if Position
not in Source
'First .. Source
'Last + 1 then
383 Result_Length
: Natural :=
386 Position
- Source
'First + New_Item
'Length);
388 Result
: Wide_String (1 .. Result_Length
);
391 Result
:= Source
(Source
'First .. Position
- 1) & New_Item
&
392 Source
(Position
+ New_Item
'Length .. Source
'Last);
399 (Source
: in out Wide_String;
400 Position
: in Positive;
401 New_Item
: in Wide_String;
402 Drop
: in Truncation
:= Right
)
405 Move
(Source
=> Overwrite
(Source
, Position
, New_Item
),
414 function Replace_Slice
415 (Source
: in Wide_String;
421 Result_Length
: Natural;
424 if Low
> Source
'Last + 1 or else High
< Source
'First - 1 then
428 Source
'Length - Natural'Max (High
- Low
+ 1, 0) + By
'Length;
431 Result
: Wide_String (1 .. Result_Length
);
436 Source
(Source
'First .. Low
- 1) & By
&
437 Source
(High
+ 1 .. Source
'Last);
439 Result
:= Source
(Source
'First .. Low
- 1) & By
&
440 Source
(Low
.. Source
'Last);
448 procedure Replace_Slice
449 (Source
: in out Wide_String;
453 Drop
: in Truncation
:= Error
;
454 Justify
: in Alignment
:= Left
;
455 Pad
: in Wide_Character := Wide_Space
)
458 Move
(Replace_Slice
(Source
, Low
, High
, By
), Source
, Drop
, Justify
, Pad
);
466 (Source
: in Wide_String;
468 Pad
: in Wide_Character := Wide_Space
)
471 Result
: Wide_String (1 .. Count
);
474 if Count
< Source
'Length then
475 Result
:= Source
(Source
'Last - Count
+ 1 .. Source
'Last);
480 for J
in 1 .. Count
- Source
'Length loop
484 Result
(Count
- Source
'Length + 1 .. Count
) := Source
;
491 (Source
: in out Wide_String;
493 Justify
: in Alignment
:= Left
;
494 Pad
: in Wide_Character := Ada
.Strings
.Wide_Space
)
497 Move
(Source
=> Tail
(Source
, Count
, Pad
),
509 (Source
: in Wide_String;
510 Mapping
: in Wide_Maps
.Wide_Character_Mapping
)
513 Result
: Wide_String (1 .. Source
'Length);
516 for J
in Source
'Range loop
517 Result
(J
- (Source
'First - 1)) := Value
(Mapping
, Source
(J
));
524 (Source
: in out Wide_String;
525 Mapping
: in Wide_Maps
.Wide_Character_Mapping
)
528 for J
in Source
'Range loop
529 Source
(J
) := Value
(Mapping
, Source
(J
));
534 (Source
: in Wide_String;
535 Mapping
: in Wide_Maps
.Wide_Character_Mapping_Function
)
538 Result
: Wide_String (1 .. Source
'Length);
541 for J
in Source
'Range loop
542 Result
(J
- (Source
'First - 1)) := Mapping
(Source
(J
));
549 (Source
: in out Wide_String;
550 Mapping
: in Wide_Maps
.Wide_Character_Mapping_Function
)
553 for J
in Source
'Range loop
554 Source
(J
) := Mapping
(Source
(J
));
563 (Source
: in Wide_String;
567 Low
: Natural := Source
'First;
568 High
: Natural := Source
'Last;
571 if Side
= Left
or else Side
= Both
then
572 while Low
<= High
and then Source
(Low
) = Wide_Space
loop
577 if Side
= Right
or else Side
= Both
then
578 while High
>= Low
and then Source
(High
) = Wide_Space
loop
588 -- At least one non-blank
592 Result
: Wide_String (1 .. High
- Low
+ 1) := Source
(Low
.. High
);
601 (Source
: in out Wide_String;
603 Justify
: in Alignment
:= Left
;
604 Pad
: in Wide_Character := Wide_Space
)
607 Move
(Source
=> Trim
(Source
, Side
),
614 (Source
: in Wide_String;
615 Left
: in Wide_Maps
.Wide_Character_Set
;
616 Right
: in Wide_Maps
.Wide_Character_Set
)
619 Low
: Natural := Source
'First;
620 High
: Natural := Source
'Last;
623 while Low
<= High
and then Is_In
(Source
(Low
), Left
) loop
627 while High
>= Low
and then Is_In
(Source
(High
), Right
) loop
631 -- Case where source comprises only characters in the sets
637 subtype WS
is Wide_String (1 .. High
- Low
+ 1);
640 return WS
(Source
(Low
.. High
));
646 (Source
: in out Wide_String;
647 Left
: in Wide_Maps
.Wide_Character_Set
;
648 Right
: in Wide_Maps
.Wide_Character_Set
;
649 Justify
: in Alignment
:= Strings
.Left
;
650 Pad
: in Wide_Character := Wide_Space
)
653 Move
(Source
=> Trim
(Source
, Left
, Right
),
659 end Ada
.Strings
.Wide_Fixed
;