1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . S T R I N G S . W I D E _ F I X E D --
9 -- Copyright (C) 1992-2005, 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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 Ada
.Strings
.Wide_Maps
; use Ada
.Strings
.Wide_Maps
;
35 with Ada
.Strings
.Wide_Search
;
37 package body Ada
.Strings
.Wide_Fixed
is
39 ------------------------
40 -- Search Subprograms --
41 ------------------------
44 (Source
: Wide_String;
45 Pattern
: Wide_String;
46 Going
: Direction
:= Forward
;
47 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
49 renames Ada
.Strings
.Wide_Search
.Index
;
52 (Source
: Wide_String;
53 Pattern
: Wide_String;
54 Going
: Direction
:= Forward
;
55 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
56 renames Ada
.Strings
.Wide_Search
.Index
;
59 (Source
: Wide_String;
60 Set
: Wide_Maps
.Wide_Character_Set
;
61 Test
: Membership
:= Inside
;
62 Going
: Direction
:= Forward
) return Natural
63 renames Ada
.Strings
.Wide_Search
.Index
;
66 (Source
: Wide_String;
67 Pattern
: Wide_String;
69 Going
: Direction
:= Forward
;
70 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
72 renames Ada
.Strings
.Wide_Search
.Index
;
75 (Source
: Wide_String;
76 Pattern
: Wide_String;
78 Going
: Direction
:= Forward
;
79 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
80 renames Ada
.Strings
.Wide_Search
.Index
;
83 (Source
: Wide_String;
84 Set
: Wide_Maps
.Wide_Character_Set
;
86 Test
: Membership
:= Inside
;
87 Going
: Direction
:= Forward
) return Natural
88 renames Ada
.Strings
.Wide_Search
.Index
;
90 function Index_Non_Blank
91 (Source
: Wide_String;
92 Going
: Direction
:= Forward
) return Natural
93 renames Ada
.Strings
.Wide_Search
.Index_Non_Blank
;
95 function Index_Non_Blank
96 (Source
: Wide_String;
98 Going
: Direction
:= Forward
) return Natural
99 renames Ada
.Strings
.Wide_Search
.Index_Non_Blank
;
102 (Source
: Wide_String;
103 Pattern
: Wide_String;
104 Mapping
: Wide_Maps
.Wide_Character_Mapping
:= Wide_Maps
.Identity
)
106 renames Ada
.Strings
.Wide_Search
.Count
;
109 (Source
: Wide_String;
110 Pattern
: Wide_String;
111 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Natural
112 renames Ada
.Strings
.Wide_Search
.Count
;
115 (Source
: Wide_String;
116 Set
: Wide_Maps
.Wide_Character_Set
) return Natural
117 renames Ada
.Strings
.Wide_Search
.Count
;
120 (Source
: Wide_String;
121 Set
: Wide_Maps
.Wide_Character_Set
;
123 First
: out Positive;
125 renames Ada
.Strings
.Wide_Search
.Find_Token
;
133 Right
: Wide_Character) return Wide_String
135 Result
: Wide_String (1 .. Left
);
138 for J
in Result
'Range loop
147 Right
: Wide_String) return Wide_String
149 Result
: Wide_String (1 .. Left
* Right
'Length);
153 for J
in 1 .. Left
loop
154 Result
(Ptr
.. Ptr
+ Right
'Length - 1) := Right
;
155 Ptr
:= Ptr
+ Right
'Length;
166 (Source
: Wide_String;
168 Through
: Natural) return Wide_String
171 if From
not in Source
'Range
172 or else Through
> Source
'Last
176 elsif From
> Through
then
181 Len
: constant Integer := Source
'Length - (Through
- From
+ 1);
183 Wide_String (Source
'First .. Source
'First + Len
- 1) :=
184 Source
(Source
'First .. From
- 1) &
185 Source
(Through
+ 1 .. Source
'Last);
193 (Source
: in out Wide_String;
196 Justify
: Alignment
:= Left
;
197 Pad
: Wide_Character := Wide_Space
)
200 Move
(Source
=> Delete
(Source
, From
, Through
),
211 (Source
: Wide_String;
213 Pad
: Wide_Character := Wide_Space
) return Wide_String
215 Result
: Wide_String (1 .. Count
);
218 if Count
<= Source
'Length then
219 Result
:= Source
(Source
'First .. Source
'First + Count
- 1);
222 Result
(1 .. Source
'Length) := Source
;
224 for J
in Source
'Length + 1 .. Count
loop
233 (Source
: in out Wide_String;
235 Justify
: Alignment
:= Left
;
236 Pad
: Wide_Character := Ada
.Strings
.Wide_Space
)
239 Move
(Source
=> Head
(Source
, Count
, Pad
),
251 (Source
: Wide_String;
253 New_Item
: Wide_String) return Wide_String
255 Result
: Wide_String (1 .. Source
'Length + New_Item
'Length);
258 if Before
< Source
'First or else Before
> Source
'Last + 1 then
262 Result
:= Source
(Source
'First .. Before
- 1) & New_Item
&
263 Source
(Before
.. Source
'Last);
268 (Source
: in out Wide_String;
270 New_Item
: Wide_String;
271 Drop
: Truncation
:= Error
)
274 Move
(Source
=> Insert
(Source
, Before
, New_Item
),
284 (Source
: Wide_String;
285 Target
: out Wide_String;
286 Drop
: Truncation
:= Error
;
287 Justify
: Alignment
:= Left
;
288 Pad
: Wide_Character := Wide_Space
)
290 Sfirst
: constant Integer := Source
'First;
291 Slast
: constant Integer := Source
'Last;
292 Slength
: constant Integer := Source
'Length;
294 Tfirst
: constant Integer := Target
'First;
295 Tlast
: constant Integer := Target
'Last;
296 Tlength
: constant Integer := Target
'Length;
298 function Is_Padding
(Item
: Wide_String) return Boolean;
299 -- Determine if all characters in Item are pad characters
305 function Is_Padding
(Item
: Wide_String) return Boolean is
307 for J
in Item
'Range loop
308 if Item
(J
) /= Pad
then
316 -- Start of processing for Move
319 if Slength
= Tlength
then
322 elsif Slength
> Tlength
then
326 Target
:= Source
(Slast
- Tlength
+ 1 .. Slast
);
329 Target
:= Source
(Sfirst
.. Sfirst
+ Tlength
- 1);
334 if Is_Padding
(Source
(Sfirst
+ Tlength
.. Slast
)) then
336 Source
(Sfirst
.. Sfirst
+ Target
'Length - 1);
342 if Is_Padding
(Source
(Sfirst
.. Slast
- Tlength
)) then
343 Target
:= Source
(Slast
- Tlength
+ 1 .. Slast
);
354 -- Source'Length < Target'Length
359 Target
(Tfirst
.. Tfirst
+ Slength
- 1) := Source
;
361 for J
in Tfirst
+ Slength
.. Tlast
loop
366 for J
in Tfirst
.. Tlast
- Slength
loop
370 Target
(Tlast
- Slength
+ 1 .. Tlast
) := Source
;
374 Front_Pad
: constant Integer := (Tlength
- Slength
) / 2;
375 Tfirst_Fpad
: constant Integer := Tfirst
+ Front_Pad
;
378 for J
in Tfirst
.. Tfirst_Fpad
- 1 loop
382 Target
(Tfirst_Fpad
.. Tfirst_Fpad
+ Slength
- 1) := Source
;
384 for J
in Tfirst_Fpad
+ Slength
.. Tlast
loop
397 (Source
: Wide_String;
399 New_Item
: Wide_String) return Wide_String
402 if Position
not in Source
'First .. Source
'Last + 1 then
406 Result_Length
: constant Natural :=
409 Position
- Source
'First + New_Item
'Length);
411 Result
: Wide_String (1 .. Result_Length
);
414 Result
:= Source
(Source
'First .. Position
- 1) & New_Item
&
415 Source
(Position
+ New_Item
'Length .. Source
'Last);
422 (Source
: in out Wide_String;
424 New_Item
: Wide_String;
425 Drop
: Truncation
:= Right
)
428 Move
(Source
=> Overwrite
(Source
, Position
, New_Item
),
437 function Replace_Slice
438 (Source
: Wide_String;
441 By
: Wide_String) return Wide_String
443 Result_Length
: Natural;
446 if Low
> Source
'Last + 1 or else High
< Source
'First - 1 then
450 Source
'Length - Natural'Max (High
- Low
+ 1, 0) + By
'Length;
453 Result
: Wide_String (1 .. Result_Length
);
458 Source
(Source
'First .. Low
- 1) & By
&
459 Source
(High
+ 1 .. Source
'Last);
461 Result
:= Source
(Source
'First .. Low
- 1) & By
&
462 Source
(Low
.. Source
'Last);
470 procedure Replace_Slice
471 (Source
: in out Wide_String;
475 Drop
: Truncation
:= Error
;
476 Justify
: Alignment
:= Left
;
477 Pad
: Wide_Character := Wide_Space
)
480 Move
(Replace_Slice
(Source
, Low
, High
, By
), Source
, Drop
, Justify
, Pad
);
488 (Source
: Wide_String;
490 Pad
: Wide_Character := Wide_Space
) return Wide_String
492 Result
: Wide_String (1 .. Count
);
495 if Count
< Source
'Length then
496 Result
:= Source
(Source
'Last - Count
+ 1 .. Source
'Last);
501 for J
in 1 .. Count
- Source
'Length loop
505 Result
(Count
- Source
'Length + 1 .. Count
) := Source
;
512 (Source
: in out Wide_String;
514 Justify
: Alignment
:= Left
;
515 Pad
: Wide_Character := Ada
.Strings
.Wide_Space
)
518 Move
(Source
=> Tail
(Source
, Count
, Pad
),
530 (Source
: Wide_String;
531 Mapping
: Wide_Maps
.Wide_Character_Mapping
) return Wide_String
533 Result
: Wide_String (1 .. Source
'Length);
536 for J
in Source
'Range loop
537 Result
(J
- (Source
'First - 1)) := Value
(Mapping
, Source
(J
));
544 (Source
: in out Wide_String;
545 Mapping
: Wide_Maps
.Wide_Character_Mapping
)
548 for J
in Source
'Range loop
549 Source
(J
) := Value
(Mapping
, Source
(J
));
554 (Source
: Wide_String;
555 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
) return Wide_String
557 Result
: Wide_String (1 .. Source
'Length);
560 for J
in Source
'Range loop
561 Result
(J
- (Source
'First - 1)) := Mapping
(Source
(J
));
568 (Source
: in out Wide_String;
569 Mapping
: Wide_Maps
.Wide_Character_Mapping_Function
)
572 for J
in Source
'Range loop
573 Source
(J
) := Mapping
(Source
(J
));
582 (Source
: Wide_String;
583 Side
: Trim_End
) return Wide_String
585 Low
: Natural := Source
'First;
586 High
: Natural := Source
'Last;
589 if Side
= Left
or else Side
= Both
then
590 while Low
<= High
and then Source
(Low
) = Wide_Space
loop
595 if Side
= Right
or else Side
= Both
then
596 while High
>= Low
and then Source
(High
) = Wide_Space
loop
606 -- At least one non-blank
610 Result
: constant Wide_String (1 .. High
- Low
+ 1) :=
611 Source
(Low
.. High
);
620 (Source
: in out Wide_String;
622 Justify
: Alignment
:= Left
;
623 Pad
: Wide_Character := Wide_Space
)
626 Move
(Source
=> Trim
(Source
, Side
),
633 (Source
: Wide_String;
634 Left
: Wide_Maps
.Wide_Character_Set
;
635 Right
: Wide_Maps
.Wide_Character_Set
) return Wide_String
637 Low
: Natural := Source
'First;
638 High
: Natural := Source
'Last;
641 while Low
<= High
and then Is_In
(Source
(Low
), Left
) loop
645 while High
>= Low
and then Is_In
(Source
(High
), Right
) loop
649 -- Case where source comprises only characters in the sets
655 subtype WS
is Wide_String (1 .. High
- Low
+ 1);
658 return WS
(Source
(Low
.. High
));
664 (Source
: in out Wide_String;
665 Left
: Wide_Maps
.Wide_Character_Set
;
666 Right
: Wide_Maps
.Wide_Character_Set
;
667 Justify
: Alignment
:= Strings
.Left
;
668 Pad
: Wide_Character := Wide_Space
)
671 Move
(Source
=> Trim
(Source
, Left
, Right
),
677 end Ada
.Strings
.Wide_Fixed
;