File : a-stwiun.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . W I D E _ U N B O U N D 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_Fixed;
33 with Ada.Strings.Wide_Search;
34 with Ada.Unchecked_Deallocation;
35
36 package body Ada.Strings.Wide_Unbounded is
37
38 use Ada.Finalization;
39
40 ---------
41 -- "&" --
42 ---------
43
44 function "&"
45 (Left : Unbounded_Wide_String;
46 Right : Unbounded_Wide_String) return Unbounded_Wide_String
47 is
48 L_Length : constant Natural := Left.Last;
49 R_Length : constant Natural := Right.Last;
50 Result : Unbounded_Wide_String;
51
52 begin
53 Result.Last := L_Length + R_Length;
54
55 Result.Reference := new Wide_String (1 .. Result.Last);
56
57 Result.Reference (1 .. L_Length) :=
58 Left.Reference (1 .. Left.Last);
59 Result.Reference (L_Length + 1 .. Result.Last) :=
60 Right.Reference (1 .. Right.Last);
61
62 return Result;
63 end "&";
64
65 function "&"
66 (Left : Unbounded_Wide_String;
67 Right : Wide_String) return Unbounded_Wide_String
68 is
69 L_Length : constant Natural := Left.Last;
70 Result : Unbounded_Wide_String;
71
72 begin
73 Result.Last := L_Length + Right'Length;
74
75 Result.Reference := new Wide_String (1 .. Result.Last);
76
77 Result.Reference (1 .. L_Length) := Left.Reference (1 .. Left.Last);
78 Result.Reference (L_Length + 1 .. Result.Last) := Right;
79
80 return Result;
81 end "&";
82
83 function "&"
84 (Left : Wide_String;
85 Right : Unbounded_Wide_String) return Unbounded_Wide_String
86 is
87 R_Length : constant Natural := Right.Last;
88 Result : Unbounded_Wide_String;
89
90 begin
91 Result.Last := Left'Length + R_Length;
92
93 Result.Reference := new Wide_String (1 .. Result.Last);
94
95 Result.Reference (1 .. Left'Length) := Left;
96 Result.Reference (Left'Length + 1 .. Result.Last) :=
97 Right.Reference (1 .. Right.Last);
98
99 return Result;
100 end "&";
101
102 function "&"
103 (Left : Unbounded_Wide_String;
104 Right : Wide_Character) return Unbounded_Wide_String
105 is
106 Result : Unbounded_Wide_String;
107
108 begin
109 Result.Last := Left.Last + 1;
110
111 Result.Reference := new Wide_String (1 .. Result.Last);
112
113 Result.Reference (1 .. Result.Last - 1) :=
114 Left.Reference (1 .. Left.Last);
115 Result.Reference (Result.Last) := Right;
116
117 return Result;
118 end "&";
119
120 function "&"
121 (Left : Wide_Character;
122 Right : Unbounded_Wide_String) return Unbounded_Wide_String
123 is
124 Result : Unbounded_Wide_String;
125
126 begin
127 Result.Last := Right.Last + 1;
128
129 Result.Reference := new Wide_String (1 .. Result.Last);
130 Result.Reference (1) := Left;
131 Result.Reference (2 .. Result.Last) :=
132 Right.Reference (1 .. Right.Last);
133 return Result;
134 end "&";
135
136 ---------
137 -- "*" --
138 ---------
139
140 function "*"
141 (Left : Natural;
142 Right : Wide_Character) return Unbounded_Wide_String
143 is
144 Result : Unbounded_Wide_String;
145
146 begin
147 Result.Last := Left;
148
149 Result.Reference := new Wide_String (1 .. Left);
150 for J in Result.Reference'Range loop
151 Result.Reference (J) := Right;
152 end loop;
153
154 return Result;
155 end "*";
156
157 function "*"
158 (Left : Natural;
159 Right : Wide_String) return Unbounded_Wide_String
160 is
161 Len : constant Natural := Right'Length;
162 K : Positive;
163 Result : Unbounded_Wide_String;
164
165 begin
166 Result.Last := Left * Len;
167
168 Result.Reference := new Wide_String (1 .. Result.Last);
169
170 K := 1;
171 for J in 1 .. Left loop
172 Result.Reference (K .. K + Len - 1) := Right;
173 K := K + Len;
174 end loop;
175
176 return Result;
177 end "*";
178
179 function "*"
180 (Left : Natural;
181 Right : Unbounded_Wide_String) return Unbounded_Wide_String
182 is
183 Len : constant Natural := Right.Last;
184 K : Positive;
185 Result : Unbounded_Wide_String;
186
187 begin
188 Result.Last := Left * Len;
189
190 Result.Reference := new Wide_String (1 .. Result.Last);
191
192 K := 1;
193 for J in 1 .. Left loop
194 Result.Reference (K .. K + Len - 1) :=
195 Right.Reference (1 .. Right.Last);
196 K := K + Len;
197 end loop;
198
199 return Result;
200 end "*";
201
202 ---------
203 -- "<" --
204 ---------
205
206 function "<"
207 (Left : Unbounded_Wide_String;
208 Right : Unbounded_Wide_String) return Boolean
209 is
210 begin
211 return
212 Left.Reference (1 .. Left.Last) < Right.Reference (1 .. Right.Last);
213 end "<";
214
215 function "<"
216 (Left : Unbounded_Wide_String;
217 Right : Wide_String) return Boolean
218 is
219 begin
220 return Left.Reference (1 .. Left.Last) < Right;
221 end "<";
222
223 function "<"
224 (Left : Wide_String;
225 Right : Unbounded_Wide_String) return Boolean
226 is
227 begin
228 return Left < Right.Reference (1 .. Right.Last);
229 end "<";
230
231 ----------
232 -- "<=" --
233 ----------
234
235 function "<="
236 (Left : Unbounded_Wide_String;
237 Right : Unbounded_Wide_String) return Boolean
238 is
239 begin
240 return
241 Left.Reference (1 .. Left.Last) <= Right.Reference (1 .. Right.Last);
242 end "<=";
243
244 function "<="
245 (Left : Unbounded_Wide_String;
246 Right : Wide_String) return Boolean
247 is
248 begin
249 return Left.Reference (1 .. Left.Last) <= Right;
250 end "<=";
251
252 function "<="
253 (Left : Wide_String;
254 Right : Unbounded_Wide_String) return Boolean
255 is
256 begin
257 return Left <= Right.Reference (1 .. Right.Last);
258 end "<=";
259
260 ---------
261 -- "=" --
262 ---------
263
264 function "="
265 (Left : Unbounded_Wide_String;
266 Right : Unbounded_Wide_String) return Boolean
267 is
268 begin
269 return
270 Left.Reference (1 .. Left.Last) = Right.Reference (1 .. Right.Last);
271 end "=";
272
273 function "="
274 (Left : Unbounded_Wide_String;
275 Right : Wide_String) return Boolean
276 is
277 begin
278 return Left.Reference (1 .. Left.Last) = Right;
279 end "=";
280
281 function "="
282 (Left : Wide_String;
283 Right : Unbounded_Wide_String) return Boolean
284 is
285 begin
286 return Left = Right.Reference (1 .. Right.Last);
287 end "=";
288
289 ---------
290 -- ">" --
291 ---------
292
293 function ">"
294 (Left : Unbounded_Wide_String;
295 Right : Unbounded_Wide_String) return Boolean
296 is
297 begin
298 return
299 Left.Reference (1 .. Left.Last) > Right.Reference (1 .. Right.Last);
300 end ">";
301
302 function ">"
303 (Left : Unbounded_Wide_String;
304 Right : Wide_String) return Boolean
305 is
306 begin
307 return Left.Reference (1 .. Left.Last) > Right;
308 end ">";
309
310 function ">"
311 (Left : Wide_String;
312 Right : Unbounded_Wide_String) return Boolean
313 is
314 begin
315 return Left > Right.Reference (1 .. Right.Last);
316 end ">";
317
318 ----------
319 -- ">=" --
320 ----------
321
322 function ">="
323 (Left : Unbounded_Wide_String;
324 Right : Unbounded_Wide_String) return Boolean
325 is
326 begin
327 return
328 Left.Reference (1 .. Left.Last) >= Right.Reference (1 .. Right.Last);
329 end ">=";
330
331 function ">="
332 (Left : Unbounded_Wide_String;
333 Right : Wide_String) return Boolean
334 is
335 begin
336 return Left.Reference (1 .. Left.Last) >= Right;
337 end ">=";
338
339 function ">="
340 (Left : Wide_String;
341 Right : Unbounded_Wide_String) return Boolean
342 is
343 begin
344 return Left >= Right.Reference (1 .. Right.Last);
345 end ">=";
346
347 ------------
348 -- Adjust --
349 ------------
350
351 procedure Adjust (Object : in out Unbounded_Wide_String) is
352 begin
353 -- Copy string, except we do not copy the statically allocated null
354 -- string, since it can never be deallocated. Note that we do not copy
355 -- extra string room here to avoid dragging unused allocated memory.
356
357 if Object.Reference /= Null_Wide_String'Access then
358 Object.Reference :=
359 new Wide_String'(Object.Reference (1 .. Object.Last));
360 end if;
361 end Adjust;
362
363 ------------
364 -- Append --
365 ------------
366
367 procedure Append
368 (Source : in out Unbounded_Wide_String;
369 New_Item : Unbounded_Wide_String)
370 is
371 begin
372 Realloc_For_Chunk (Source, New_Item.Last);
373 Source.Reference (Source.Last + 1 .. Source.Last + New_Item.Last) :=
374 New_Item.Reference (1 .. New_Item.Last);
375 Source.Last := Source.Last + New_Item.Last;
376 end Append;
377
378 procedure Append
379 (Source : in out Unbounded_Wide_String;
380 New_Item : Wide_String)
381 is
382 begin
383 Realloc_For_Chunk (Source, New_Item'Length);
384 Source.Reference (Source.Last + 1 .. Source.Last + New_Item'Length) :=
385 New_Item;
386 Source.Last := Source.Last + New_Item'Length;
387 end Append;
388
389 procedure Append
390 (Source : in out Unbounded_Wide_String;
391 New_Item : Wide_Character)
392 is
393 begin
394 Realloc_For_Chunk (Source, 1);
395 Source.Reference (Source.Last + 1) := New_Item;
396 Source.Last := Source.Last + 1;
397 end Append;
398
399 -----------
400 -- Count --
401 -----------
402
403 function Count
404 (Source : Unbounded_Wide_String;
405 Pattern : Wide_String;
406 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
407 return Natural
408 is
409 begin
410 return
411 Wide_Search.Count
412 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
413 end Count;
414
415 function Count
416 (Source : Unbounded_Wide_String;
417 Pattern : Wide_String;
418 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
419 is
420 begin
421 return
422 Wide_Search.Count
423 (Source.Reference (1 .. Source.Last), Pattern, Mapping);
424 end Count;
425
426 function Count
427 (Source : Unbounded_Wide_String;
428 Set : Wide_Maps.Wide_Character_Set) return Natural
429 is
430 begin
431 return
432 Wide_Search.Count
433 (Source.Reference (1 .. Source.Last), Set);
434 end Count;
435
436 ------------
437 -- Delete --
438 ------------
439
440 function Delete
441 (Source : Unbounded_Wide_String;
442 From : Positive;
443 Through : Natural) return Unbounded_Wide_String
444 is
445 begin
446 return
447 To_Unbounded_Wide_String
448 (Wide_Fixed.Delete
449 (Source.Reference (1 .. Source.Last), From, Through));
450 end Delete;
451
452 procedure Delete
453 (Source : in out Unbounded_Wide_String;
454 From : Positive;
455 Through : Natural)
456 is
457 begin
458 if From > Through then
459 null;
460
461 elsif From < Source.Reference'First or else Through > Source.Last then
462 raise Index_Error;
463
464 else
465 declare
466 Len : constant Natural := Through - From + 1;
467
468 begin
469 Source.Reference (From .. Source.Last - Len) :=
470 Source.Reference (Through + 1 .. Source.Last);
471 Source.Last := Source.Last - Len;
472 end;
473 end if;
474 end Delete;
475
476 -------------
477 -- Element --
478 -------------
479
480 function Element
481 (Source : Unbounded_Wide_String;
482 Index : Positive) return Wide_Character
483 is
484 begin
485 if Index <= Source.Last then
486 return Source.Reference (Index);
487 else
488 raise Strings.Index_Error;
489 end if;
490 end Element;
491
492 --------------
493 -- Finalize --
494 --------------
495
496 procedure Finalize (Object : in out Unbounded_Wide_String) is
497 procedure Deallocate is
498 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
499
500 begin
501 -- Note: Don't try to free statically allocated null string
502
503 if Object.Reference /= Null_Wide_String'Access then
504 Deallocate (Object.Reference);
505 Object.Reference := Null_Unbounded_Wide_String.Reference;
506 Object.Last := 0;
507 end if;
508 end Finalize;
509
510 ----------------
511 -- Find_Token --
512 ----------------
513
514 procedure Find_Token
515 (Source : Unbounded_Wide_String;
516 Set : Wide_Maps.Wide_Character_Set;
517 From : Positive;
518 Test : Strings.Membership;
519 First : out Positive;
520 Last : out Natural)
521 is
522 begin
523 Wide_Search.Find_Token
524 (Source.Reference (From .. Source.Last), Set, Test, First, Last);
525 end Find_Token;
526
527 procedure Find_Token
528 (Source : Unbounded_Wide_String;
529 Set : Wide_Maps.Wide_Character_Set;
530 Test : Strings.Membership;
531 First : out Positive;
532 Last : out Natural)
533 is
534 begin
535 Wide_Search.Find_Token
536 (Source.Reference (1 .. Source.Last), Set, Test, First, Last);
537 end Find_Token;
538
539 ----------
540 -- Free --
541 ----------
542
543 procedure Free (X : in out Wide_String_Access) is
544 procedure Deallocate is
545 new Ada.Unchecked_Deallocation (Wide_String, Wide_String_Access);
546
547 begin
548 -- Note: Do not try to free statically allocated null string
549
550 if X /= Null_Unbounded_Wide_String.Reference then
551 Deallocate (X);
552 end if;
553 end Free;
554
555 ----------
556 -- Head --
557 ----------
558
559 function Head
560 (Source : Unbounded_Wide_String;
561 Count : Natural;
562 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String
563 is
564 begin
565 return To_Unbounded_Wide_String
566 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
567 end Head;
568
569 procedure Head
570 (Source : in out Unbounded_Wide_String;
571 Count : Natural;
572 Pad : Wide_Character := Wide_Space)
573 is
574 Old : Wide_String_Access := Source.Reference;
575 begin
576 Source.Reference :=
577 new Wide_String'
578 (Wide_Fixed.Head (Source.Reference (1 .. Source.Last), Count, Pad));
579 Source.Last := Source.Reference'Length;
580 Free (Old);
581 end Head;
582
583 -----------
584 -- Index --
585 -----------
586
587 function Index
588 (Source : Unbounded_Wide_String;
589 Pattern : Wide_String;
590 Going : Strings.Direction := Strings.Forward;
591 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
592 return Natural
593 is
594 begin
595 return
596 Wide_Search.Index
597 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
598 end Index;
599
600 function Index
601 (Source : Unbounded_Wide_String;
602 Pattern : Wide_String;
603 Going : Direction := Forward;
604 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
605 is
606 begin
607 return
608 Wide_Search.Index
609 (Source.Reference (1 .. Source.Last), Pattern, Going, Mapping);
610 end Index;
611
612 function Index
613 (Source : Unbounded_Wide_String;
614 Set : Wide_Maps.Wide_Character_Set;
615 Test : Strings.Membership := Strings.Inside;
616 Going : Strings.Direction := Strings.Forward) return Natural
617 is
618 begin
619 return Wide_Search.Index
620 (Source.Reference (1 .. Source.Last), Set, Test, Going);
621 end Index;
622
623 function Index
624 (Source : Unbounded_Wide_String;
625 Pattern : Wide_String;
626 From : Positive;
627 Going : Direction := Forward;
628 Mapping : Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
629 return Natural
630 is
631 begin
632 return
633 Wide_Search.Index
634 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
635 end Index;
636
637 function Index
638 (Source : Unbounded_Wide_String;
639 Pattern : Wide_String;
640 From : Positive;
641 Going : Direction := Forward;
642 Mapping : Wide_Maps.Wide_Character_Mapping_Function) return Natural
643 is
644 begin
645 return
646 Wide_Search.Index
647 (Source.Reference (1 .. Source.Last), Pattern, From, Going, Mapping);
648 end Index;
649
650 function Index
651 (Source : Unbounded_Wide_String;
652 Set : Wide_Maps.Wide_Character_Set;
653 From : Positive;
654 Test : Membership := Inside;
655 Going : Direction := Forward) return Natural
656 is
657 begin
658 return
659 Wide_Search.Index
660 (Source.Reference (1 .. Source.Last), Set, From, Test, Going);
661 end Index;
662
663 function Index_Non_Blank
664 (Source : Unbounded_Wide_String;
665 Going : Strings.Direction := Strings.Forward) return Natural
666 is
667 begin
668 return
669 Wide_Search.Index_Non_Blank
670 (Source.Reference (1 .. Source.Last), Going);
671 end Index_Non_Blank;
672
673 function Index_Non_Blank
674 (Source : Unbounded_Wide_String;
675 From : Positive;
676 Going : Direction := Forward) return Natural
677 is
678 begin
679 return
680 Wide_Search.Index_Non_Blank
681 (Source.Reference (1 .. Source.Last), From, Going);
682 end Index_Non_Blank;
683
684 ----------------
685 -- Initialize --
686 ----------------
687
688 procedure Initialize (Object : in out Unbounded_Wide_String) is
689 begin
690 Object.Reference := Null_Unbounded_Wide_String.Reference;
691 Object.Last := 0;
692 end Initialize;
693
694 ------------
695 -- Insert --
696 ------------
697
698 function Insert
699 (Source : Unbounded_Wide_String;
700 Before : Positive;
701 New_Item : Wide_String) return Unbounded_Wide_String
702 is
703 begin
704 return
705 To_Unbounded_Wide_String
706 (Wide_Fixed.Insert
707 (Source.Reference (1 .. Source.Last), Before, New_Item));
708 end Insert;
709
710 procedure Insert
711 (Source : in out Unbounded_Wide_String;
712 Before : Positive;
713 New_Item : Wide_String)
714 is
715 begin
716 if Before not in Source.Reference'First .. Source.Last + 1 then
717 raise Index_Error;
718 end if;
719
720 Realloc_For_Chunk (Source, New_Item'Length);
721
722 Source.Reference
723 (Before + New_Item'Length .. Source.Last + New_Item'Length) :=
724 Source.Reference (Before .. Source.Last);
725
726 Source.Reference (Before .. Before + New_Item'Length - 1) := New_Item;
727 Source.Last := Source.Last + New_Item'Length;
728 end Insert;
729
730 ------------
731 -- Length --
732 ------------
733
734 function Length (Source : Unbounded_Wide_String) return Natural is
735 begin
736 return Source.Last;
737 end Length;
738
739 ---------------
740 -- Overwrite --
741 ---------------
742
743 function Overwrite
744 (Source : Unbounded_Wide_String;
745 Position : Positive;
746 New_Item : Wide_String) return Unbounded_Wide_String
747 is
748 begin
749 return
750 To_Unbounded_Wide_String
751 (Wide_Fixed.Overwrite
752 (Source.Reference (1 .. Source.Last), Position, New_Item));
753 end Overwrite;
754
755 procedure Overwrite
756 (Source : in out Unbounded_Wide_String;
757 Position : Positive;
758 New_Item : Wide_String)
759 is
760 NL : constant Natural := New_Item'Length;
761 begin
762 if Position <= Source.Last - NL + 1 then
763 Source.Reference (Position .. Position + NL - 1) := New_Item;
764 else
765 declare
766 Old : Wide_String_Access := Source.Reference;
767 begin
768 Source.Reference := new Wide_String'
769 (Wide_Fixed.Overwrite
770 (Source.Reference (1 .. Source.Last), Position, New_Item));
771 Source.Last := Source.Reference'Length;
772 Free (Old);
773 end;
774 end if;
775 end Overwrite;
776
777 -----------------------
778 -- Realloc_For_Chunk --
779 -----------------------
780
781 procedure Realloc_For_Chunk
782 (Source : in out Unbounded_Wide_String;
783 Chunk_Size : Natural)
784 is
785 Growth_Factor : constant := 32;
786 -- The growth factor controls how much extra space is allocated when
787 -- we have to increase the size of an allocated unbounded string. By
788 -- allocating extra space, we avoid the need to reallocate on every
789 -- append, particularly important when a string is built up by repeated
790 -- append operations of small pieces. This is expressed as a factor so
791 -- 32 means add 1/32 of the length of the string as growth space.
792
793 Min_Mul_Alloc : constant := Standard'Maximum_Alignment;
794 -- Allocation will be done by a multiple of Min_Mul_Alloc This causes
795 -- no memory loss as most (all?) malloc implementations are obliged to
796 -- align the returned memory on the maximum alignment as malloc does not
797 -- know the target alignment.
798
799 S_Length : constant Natural := Source.Reference'Length;
800
801 begin
802 if Chunk_Size > S_Length - Source.Last then
803 declare
804 New_Size : constant Positive :=
805 S_Length + Chunk_Size + (S_Length / Growth_Factor);
806
807 New_Rounded_Up_Size : constant Positive :=
808 ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc;
809
810 Tmp : constant Wide_String_Access :=
811 new Wide_String (1 .. New_Rounded_Up_Size);
812
813 begin
814 Tmp (1 .. Source.Last) := Source.Reference (1 .. Source.Last);
815 Free (Source.Reference);
816 Source.Reference := Tmp;
817 end;
818 end if;
819 end Realloc_For_Chunk;
820
821 ---------------------
822 -- Replace_Element --
823 ---------------------
824
825 procedure Replace_Element
826 (Source : in out Unbounded_Wide_String;
827 Index : Positive;
828 By : Wide_Character)
829 is
830 begin
831 if Index <= Source.Last then
832 Source.Reference (Index) := By;
833 else
834 raise Strings.Index_Error;
835 end if;
836 end Replace_Element;
837
838 -------------------
839 -- Replace_Slice --
840 -------------------
841
842 function Replace_Slice
843 (Source : Unbounded_Wide_String;
844 Low : Positive;
845 High : Natural;
846 By : Wide_String) return Unbounded_Wide_String
847 is
848 begin
849 return To_Unbounded_Wide_String
850 (Wide_Fixed.Replace_Slice
851 (Source.Reference (1 .. Source.Last), Low, High, By));
852 end Replace_Slice;
853
854 procedure Replace_Slice
855 (Source : in out Unbounded_Wide_String;
856 Low : Positive;
857 High : Natural;
858 By : Wide_String)
859 is
860 Old : Wide_String_Access := Source.Reference;
861 begin
862 Source.Reference := new Wide_String'
863 (Wide_Fixed.Replace_Slice
864 (Source.Reference (1 .. Source.Last), Low, High, By));
865 Source.Last := Source.Reference'Length;
866 Free (Old);
867 end Replace_Slice;
868
869 -------------------------------
870 -- Set_Unbounded_Wide_String --
871 -------------------------------
872
873 procedure Set_Unbounded_Wide_String
874 (Target : out Unbounded_Wide_String;
875 Source : Wide_String)
876 is
877 begin
878 Target.Last := Source'Length;
879 Target.Reference := new Wide_String (1 .. Source'Length);
880 Target.Reference.all := Source;
881 end Set_Unbounded_Wide_String;
882
883 -----------
884 -- Slice --
885 -----------
886
887 function Slice
888 (Source : Unbounded_Wide_String;
889 Low : Positive;
890 High : Natural) return Wide_String
891 is
892 begin
893 -- Note: test of High > Length is in accordance with AI95-00128
894
895 if Low > Source.Last + 1 or else High > Source.Last then
896 raise Index_Error;
897 else
898 return Source.Reference (Low .. High);
899 end if;
900 end Slice;
901
902 ----------
903 -- Tail --
904 ----------
905
906 function Tail
907 (Source : Unbounded_Wide_String;
908 Count : Natural;
909 Pad : Wide_Character := Wide_Space) return Unbounded_Wide_String is
910 begin
911 return To_Unbounded_Wide_String
912 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
913 end Tail;
914
915 procedure Tail
916 (Source : in out Unbounded_Wide_String;
917 Count : Natural;
918 Pad : Wide_Character := Wide_Space)
919 is
920 Old : Wide_String_Access := Source.Reference;
921 begin
922 Source.Reference := new Wide_String'
923 (Wide_Fixed.Tail (Source.Reference (1 .. Source.Last), Count, Pad));
924 Source.Last := Source.Reference'Length;
925 Free (Old);
926 end Tail;
927
928 ------------------------------
929 -- To_Unbounded_Wide_String --
930 ------------------------------
931
932 function To_Unbounded_Wide_String
933 (Source : Wide_String)
934 return Unbounded_Wide_String
935 is
936 Result : Unbounded_Wide_String;
937 begin
938 Result.Last := Source'Length;
939 Result.Reference := new Wide_String (1 .. Source'Length);
940 Result.Reference.all := Source;
941 return Result;
942 end To_Unbounded_Wide_String;
943
944 function To_Unbounded_Wide_String
945 (Length : Natural) return Unbounded_Wide_String
946 is
947 Result : Unbounded_Wide_String;
948 begin
949 Result.Last := Length;
950 Result.Reference := new Wide_String (1 .. Length);
951 return Result;
952 end To_Unbounded_Wide_String;
953
954 -------------------
955 -- To_Wide_String --
956 --------------------
957
958 function To_Wide_String
959 (Source : Unbounded_Wide_String)
960 return Wide_String
961 is
962 begin
963 return Source.Reference (1 .. Source.Last);
964 end To_Wide_String;
965
966 ---------------
967 -- Translate --
968 ---------------
969
970 function Translate
971 (Source : Unbounded_Wide_String;
972 Mapping : Wide_Maps.Wide_Character_Mapping)
973 return Unbounded_Wide_String
974 is
975 begin
976 return
977 To_Unbounded_Wide_String
978 (Wide_Fixed.Translate
979 (Source.Reference (1 .. Source.Last), Mapping));
980 end Translate;
981
982 procedure Translate
983 (Source : in out Unbounded_Wide_String;
984 Mapping : Wide_Maps.Wide_Character_Mapping)
985 is
986 begin
987 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
988 end Translate;
989
990 function Translate
991 (Source : Unbounded_Wide_String;
992 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
993 return Unbounded_Wide_String
994 is
995 begin
996 return
997 To_Unbounded_Wide_String
998 (Wide_Fixed.Translate
999 (Source.Reference (1 .. Source.Last), Mapping));
1000 end Translate;
1001
1002 procedure Translate
1003 (Source : in out Unbounded_Wide_String;
1004 Mapping : Wide_Maps.Wide_Character_Mapping_Function)
1005 is
1006 begin
1007 Wide_Fixed.Translate (Source.Reference (1 .. Source.Last), Mapping);
1008 end Translate;
1009
1010 ----------
1011 -- Trim --
1012 ----------
1013
1014 function Trim
1015 (Source : Unbounded_Wide_String;
1016 Side : Trim_End) return Unbounded_Wide_String
1017 is
1018 begin
1019 return
1020 To_Unbounded_Wide_String
1021 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1022 end Trim;
1023
1024 procedure Trim
1025 (Source : in out Unbounded_Wide_String;
1026 Side : Trim_End)
1027 is
1028 Old : Wide_String_Access := Source.Reference;
1029 begin
1030 Source.Reference :=
1031 new Wide_String'
1032 (Wide_Fixed.Trim (Source.Reference (1 .. Source.Last), Side));
1033 Source.Last := Source.Reference'Length;
1034 Free (Old);
1035 end Trim;
1036
1037 function Trim
1038 (Source : Unbounded_Wide_String;
1039 Left : Wide_Maps.Wide_Character_Set;
1040 Right : Wide_Maps.Wide_Character_Set)
1041 return Unbounded_Wide_String
1042 is
1043 begin
1044 return
1045 To_Unbounded_Wide_String
1046 (Wide_Fixed.Trim
1047 (Source.Reference (1 .. Source.Last), Left, Right));
1048 end Trim;
1049
1050 procedure Trim
1051 (Source : in out Unbounded_Wide_String;
1052 Left : Wide_Maps.Wide_Character_Set;
1053 Right : Wide_Maps.Wide_Character_Set)
1054 is
1055 Old : Wide_String_Access := Source.Reference;
1056 begin
1057 Source.Reference :=
1058 new Wide_String'
1059 (Wide_Fixed.Trim
1060 (Source.Reference (1 .. Source.Last), Left, Right));
1061 Source.Last := Source.Reference'Length;
1062 Free (Old);
1063 end Trim;
1064
1065 ---------------------
1066 -- Unbounded_Slice --
1067 ---------------------
1068
1069 function Unbounded_Slice
1070 (Source : Unbounded_Wide_String;
1071 Low : Positive;
1072 High : Natural) return Unbounded_Wide_String
1073 is
1074 begin
1075 if Low > Source.Last + 1 or else High > Source.Last then
1076 raise Index_Error;
1077 else
1078 return To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
1079 end if;
1080 end Unbounded_Slice;
1081
1082 procedure Unbounded_Slice
1083 (Source : Unbounded_Wide_String;
1084 Target : out Unbounded_Wide_String;
1085 Low : Positive;
1086 High : Natural)
1087 is
1088 begin
1089 if Low > Source.Last + 1 or else High > Source.Last then
1090 raise Index_Error;
1091 else
1092 Target :=
1093 To_Unbounded_Wide_String (Source.Reference.all (Low .. High));
1094 end if;
1095 end Unbounded_Slice;
1096
1097 end Ada.Strings.Wide_Unbounded;