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