1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . W I D E _ W I D E _ T E X T _ I O . E D I T I N G --
9 -- Copyright (C) 1992-2007, 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.Fixed;
35 with Ada.Strings.Wide_Wide_Fixed;
37 package body Ada.Wide_Wide_Text_IO.Editing is
39 package Strings renames Ada.Strings;
40 package Strings_Fixed renames Ada.Strings.Fixed;
41 package Strings_Wide_Wide_Fixed renames Ada.Strings.Wide_Wide_Fixed;
42 package Wide_Wide_Text_IO renames Ada.Wide_Wide_Text_IO;
44 -----------------------
45 -- Local_Subprograms --
46 -----------------------
48 function To_Wide (C : Character) return Wide_Wide_Character;
49 pragma Inline (To_Wide);
50 -- Convert Character to corresponding Wide_Wide_Character
56 function Blank_When_Zero (Pic : Picture) return Boolean is
58 return Pic.Contents.Original_BWZ;
65 package body Decimal_Output is
74 Currency : Wide_Wide_String := Default_Currency;
75 Fill : Wide_Wide_Character := Default_Fill;
76 Separator : Wide_Wide_Character := Default_Separator;
77 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark)
78 return Wide_Wide_String
82 (Pic.Contents, Num'Image (Item),
83 Currency, Fill, Separator, Radix_Mark);
92 Currency : Wide_Wide_String := Default_Currency) return Natural
94 Picstr : constant String := Pic_String (Pic);
95 V_Adjust : Integer := 0;
96 Cur_Adjust : Integer := 0;
99 -- Check if Picstr has 'V' or '$'
101 -- If 'V', then length is 1 less than otherwise
103 -- If '$', then length is Currency'Length-1 more than otherwise
105 -- This should use the string handling package ???
107 for J in Picstr'Range loop
108 if Picstr (J) = 'V' then
111 elsif Picstr (J) = '$' then
112 Cur_Adjust := Currency'Length - 1;
116 return Picstr'Length - V_Adjust + Cur_Adjust;
124 (File : Wide_Wide_Text_IO.File_Type;
127 Currency : Wide_Wide_String := Default_Currency;
128 Fill : Wide_Wide_Character := Default_Fill;
129 Separator : Wide_Wide_Character := Default_Separator;
130 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark)
133 Wide_Wide_Text_IO.Put (File, Image (Item, Pic,
134 Currency, Fill, Separator, Radix_Mark));
140 Currency : Wide_Wide_String := Default_Currency;
141 Fill : Wide_Wide_Character := Default_Fill;
142 Separator : Wide_Wide_Character := Default_Separator;
143 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark)
146 Wide_Wide_Text_IO.Put (Image (Item, Pic,
147 Currency, Fill, Separator, Radix_Mark));
151 (To : out Wide_Wide_String;
154 Currency : Wide_Wide_String := Default_Currency;
155 Fill : Wide_Wide_Character := Default_Fill;
156 Separator : Wide_Wide_Character := Default_Separator;
157 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark)
159 Result : constant Wide_Wide_String :=
160 Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
163 if Result'Length > To'Length then
164 raise Wide_Wide_Text_IO.Layout_Error;
166 Strings_Wide_Wide_Fixed.Move (Source => Result, Target => To,
167 Justify => Strings.Right);
178 Currency : Wide_Wide_String := Default_Currency) return Boolean
182 Temp : constant Wide_Wide_String := Image (Item, Pic, Currency);
183 pragma Warnings (Off, Temp);
189 when Layout_Error => return False;
198 function Expand (Picture : String) return String is
199 Result : String (1 .. MAX_PICSIZE);
200 Picture_Index : Integer := Picture'First;
201 Result_Index : Integer := Result'First;
206 if Picture'Length < 1 then
210 if Picture (Picture'First) = '(' then
215 case Picture (Picture_Index) is
219 -- We now need to scan out the count after a left paren. In
220 -- the non-wide version we used Integer_IO.Get, but that is
221 -- not convenient here, since we don't want to drag in normal
222 -- Text_IO just for this purpose. So we do the scan ourselves,
223 -- with the normal validity checks.
225 Last := Picture_Index + 1;
228 if Picture (Last) not in '0' .. '9' then
232 Count := Character'Pos (Picture (Last)) - Character'Pos ('0');
236 if Last > Picture'Last then
240 if Picture (Last) = '_' then
241 if Picture (Last - 1) = '_' then
245 elsif Picture (Last) = ')' then
248 elsif Picture (Last) not in '0' .. '9' then
253 + Character'Pos (Picture (Last)) -
260 -- In what follows note that one copy of the repeated
261 -- character has already been made, so a count of one is
262 -- no-op, and a count of zero erases a character.
264 for J in 2 .. Count loop
265 Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
268 Result_Index := Result_Index + Count - 1;
270 -- Last was a ')' throw it away too
272 Picture_Index := Last + 1;
278 Result (Result_Index) := Picture (Picture_Index);
279 Picture_Index := Picture_Index + 1;
280 Result_Index := Result_Index + 1;
284 exit when Picture_Index > Picture'Last;
287 return Result (1 .. Result_Index - 1);
298 function Format_Number
299 (Pic : Format_Record;
301 Currency_Symbol : Wide_Wide_String;
302 Fill_Character : Wide_Wide_Character;
303 Separator_Character : Wide_Wide_Character;
304 Radix_Point : Wide_Wide_Character) return Wide_Wide_String
306 Attrs : Number_Attributes := Parse_Number_String (Number);
308 Rounded : String := Number;
310 Sign_Position : Integer := Pic.Sign_Position; -- may float.
312 Answer : Wide_Wide_String (1 .. Pic.Picture.Length);
314 Currency_Pos : Integer := Pic.Start_Currency;
316 Dollar : Boolean := False;
317 -- Overridden immediately if necessary
319 Zero : Boolean := True;
320 -- Set to False when a non-zero digit is output
324 -- If the picture has fewer decimal places than the number, the image
325 -- must be rounded according to the usual rules.
327 if Attrs.Has_Fraction then
329 R : constant Integer :=
330 (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
331 - Pic.Max_Trailing_Digits;
336 R_Pos := Rounded'Length - R;
338 if Rounded (R_Pos + 1) > '4' then
340 if Rounded (R_Pos) = '.' then
344 if Rounded (R_Pos) /= '9' then
345 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
347 Rounded (R_Pos) := '0';
351 if Rounded (R_Pos) = '.' then
355 if Rounded (R_Pos) /= '9' then
356 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
359 Rounded (R_Pos) := '0';
364 -- The rounding may add a digit in front. Either the
365 -- leading blank or the sign (already captured) can be
369 Rounded (R_Pos) := '1';
370 Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
378 for J in Answer'Range loop
379 Answer (J) := To_Wide (Pic.Picture.Expanded (J));
382 if Pic.Start_Currency /= Invalid_Position then
383 Dollar := Answer (Pic.Start_Currency) = '$';
386 -- Fix up "direct inserts" outside the playing field. Set up as one
387 -- loop to do the beginning, one (reverse) loop to do the end.
391 exit when Last = Pic.Start_Float;
392 exit when Last = Pic.Radix_Position;
393 exit when Answer (Last) = '9';
395 case Answer (Last) is
398 Answer (Last) := Separator_Character;
401 Answer (Last) := ' ';
408 exit when Last = Answer'Last;
413 -- Now for the end...
415 for J in reverse Last .. Answer'Last loop
416 exit when J = Pic.Radix_Position;
418 -- Do this test First, Separator_Character can equal Pic.Floater
420 if Answer (J) = Pic.Floater then
427 Answer (J) := Separator_Character;
443 if Pic.Start_Currency /= -1
444 and then Answer (Pic.Start_Currency) = '#'
445 and then Pic.Floater /= '#'
447 if Currency_Symbol'Length >
448 Pic.End_Currency - Pic.Start_Currency + 1
452 elsif Currency_Symbol'Length =
453 Pic.End_Currency - Pic.Start_Currency + 1
455 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
458 elsif Pic.Radix_Position = Invalid_Position
459 or else Pic.Start_Currency < Pic.Radix_Position
461 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
463 Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
464 Pic.End_Currency) := Currency_Symbol;
467 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
469 Answer (Pic.Start_Currency ..
470 Pic.Start_Currency + Currency_Symbol'Length - 1) :=
475 -- Fill in leading digits
477 if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
478 Pic.Max_Leading_Digits
483 if Pic.Radix_Position = Invalid_Position then
484 Position := Answer'Last;
486 Position := Pic.Radix_Position - 1;
489 for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
491 while Answer (Position) /= '9'
492 and Answer (Position) /= Pic.Floater
494 if Answer (Position) = '_' then
495 Answer (Position) := Separator_Character;
497 elsif Answer (Position) = 'b' then
498 Answer (Position) := ' ';
501 Position := Position - 1;
504 Answer (Position) := To_Wide (Rounded (J));
506 if Rounded (J) /= '0' then
510 Position := Position - 1;
515 if Pic.Start_Float = Invalid_Position then
517 -- No leading floats, but need to change '9' to '0', '_' to
518 -- Separator_Character and 'b' to ' '.
520 for J in Last .. Position loop
522 -- Last set when fixing the "uninteresting" leaders above.
523 -- Don't duplicate the work.
525 if Answer (J) = '9' then
528 elsif Answer (J) = '_' then
529 Answer (J) := Separator_Character;
531 elsif Answer (J) = 'b' then
538 elsif Pic.Floater = '<'
544 for J in Pic.End_Float .. Position loop -- May be null range
545 if Answer (J) = '9' then
548 elsif Answer (J) = '_' then
549 Answer (J) := Separator_Character;
551 elsif Answer (J) = 'b' then
557 if Position > Pic.End_Float then
558 Position := Pic.End_Float;
561 for J in Pic.Start_Float .. Position - 1 loop
565 Answer (Position) := Pic.Floater;
566 Sign_Position := Position;
568 elsif Pic.Floater = '$' then
570 for J in Pic.End_Float .. Position loop -- May be null range
571 if Answer (J) = '9' then
574 elsif Answer (J) = '_' then
575 Answer (J) := ' '; -- no separator before leftmost digit
577 elsif Answer (J) = 'b' then
582 if Position > Pic.End_Float then
583 Position := Pic.End_Float;
586 for J in Pic.Start_Float .. Position - 1 loop
590 Answer (Position) := Pic.Floater;
591 Currency_Pos := Position;
593 elsif Pic.Floater = '*' then
595 for J in Pic.End_Float .. Position loop -- May be null range
596 if Answer (J) = '9' then
599 elsif Answer (J) = '_' then
600 Answer (J) := Separator_Character;
602 elsif Answer (J) = 'b' then
607 if Position > Pic.End_Float then
608 Position := Pic.End_Float;
611 for J in Pic.Start_Float .. Position loop
616 if Pic.Floater = '#' then
617 Currency_Pos := Currency_Symbol'Length;
620 for J in reverse Pic.Start_Float .. Position loop
624 Answer (J) := Fill_Character;
626 when 'Z' | 'b' | '/' | '0' =>
632 when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
636 if Currency_Pos = 0 then
639 Answer (J) := Currency_Symbol (Currency_Pos);
640 Currency_Pos := Currency_Pos - 1;
648 Answer (J) := Fill_Character;
654 if Currency_Pos = 0 then
658 Answer (J) := Currency_Symbol (Currency_Pos);
659 Currency_Pos := Currency_Pos - 1;
673 if Pic.Floater = '#' and then Currency_Pos /= 0 then
680 if Sign_Position = Invalid_Position then
681 if Attrs.Negative then
686 if Attrs.Negative then
687 case Answer (Sign_Position) is
688 when 'C' | 'D' | '-' =>
692 Answer (Sign_Position) := '-';
695 Answer (Sign_Position) := '(';
696 Answer (Pic.Second_Sign) := ')';
705 case Answer (Sign_Position) is
708 Answer (Sign_Position) := ' ';
710 when '<' | 'C' | 'D' =>
711 Answer (Sign_Position) := ' ';
712 Answer (Pic.Second_Sign) := ' ';
724 -- Fill in trailing digits
726 if Pic.Max_Trailing_Digits > 0 then
728 if Attrs.Has_Fraction then
729 Position := Attrs.Start_Of_Fraction;
730 Last := Pic.Radix_Position + 1;
732 for J in Last .. Answer'Last loop
734 if Answer (J) = '9' or Answer (J) = Pic.Floater then
735 Answer (J) := To_Wide (Rounded (Position));
737 if Rounded (Position) /= '0' then
741 Position := Position + 1;
744 -- Used up fraction but remember place in Answer
746 exit when Position > Attrs.End_Of_Fraction;
748 elsif Answer (J) = 'b' then
751 elsif Answer (J) = '_' then
752 Answer (J) := Separator_Character;
762 Position := Pic.Radix_Position + 1;
765 -- Now fill remaining 9's with zeros and _ with separators
769 for J in Position .. Last loop
770 if Answer (J) = '9' then
773 elsif Answer (J) = Pic.Floater then
776 elsif Answer (J) = '_' then
777 Answer (J) := Separator_Character;
779 elsif Answer (J) = 'b' then
785 Position := Last + 1;
788 if Pic.Floater = '#' and then Currency_Pos /= 0 then
792 -- No trailing digits, but now J may need to stick in a currency
795 if Pic.Start_Currency = Invalid_Position then
796 Position := Answer'Last + 1;
798 Position := Pic.Start_Currency;
802 for J in Position .. Answer'Last loop
804 if Pic.Start_Currency /= Invalid_Position and then
805 Answer (Pic.Start_Currency) = '#' then
809 -- Note: There are some weird cases J can imagine with 'b' or '#'
810 -- in currency strings where the following code will cause
811 -- glitches. The trick is to tell when the character in the
812 -- answer should be checked, and when to look at the original
813 -- string. Some other time. RIE 11/26/96 ???
817 Answer (J) := Fill_Character;
823 if Currency_Pos > Currency_Symbol'Length then
827 Answer (J) := Currency_Symbol (Currency_Pos);
828 Currency_Pos := Currency_Pos + 1;
836 Answer (J) := Fill_Character;
842 if Currency_Pos > Currency_Symbol'Length then
845 Answer (J) := Currency_Symbol (Currency_Pos);
846 Currency_Pos := Currency_Pos + 1;
860 -- Now get rid of Blank_when_Zero and complete Star fill
862 if Zero and Pic.Blank_When_Zero then
864 -- Value is zero, and blank it
869 Last := Last - 1 + Currency_Symbol'Length;
872 if Pic.Radix_Position /= Invalid_Position and then
873 Answer (Pic.Radix_Position) = 'V' then
877 return Wide_Wide_String'(1 .. Last => ' ');
879 elsif Zero and Pic.Star_Fill then
883 Last := Last - 1 + Currency_Symbol'Length;
886 if Pic.Radix_Position /= Invalid_Position then
888 if Answer (Pic.Radix_Position) = 'V' then
892 if Pic.Radix_Position > Pic.Start_Currency then
894 Wide_Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
896 Wide_Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
902 Pic.Radix_Position + Currency_Symbol'Length - 2
906 (Pic.Radix_Position + Currency_Symbol'Length .. Last
912 Wide_Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
914 Wide_Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
918 return Wide_Wide_String'(1 .. Last => '*');
921 -- This was once a simple return statement, now there are nine
922 -- different return cases. Not to mention the five above to deal
923 -- with zeros. Why not split things out?
925 -- Processing the radix and sign expansion separately
926 -- would require lots of copying--the string and some of its
927 -- indicies--without really simplifying the logic. The cases are:
929 -- 1) Expand $, replace '.' with Radix_Point
930 -- 2) No currency expansion, replace '.' with Radix_Point
931 -- 3) Expand $, radix blanked
932 -- 4) No currency expansion, radix blanked
934 -- 6) Expand $, Elide V
935 -- 7) Elide V, Expand $ (Two cases depending on order.)
936 -- 8) No radix, expand $
937 -- 9) No radix, no currency expansion
939 if Pic.Radix_Position /= Invalid_Position then
941 if Answer (Pic.Radix_Position) = '.' then
942 Answer (Pic.Radix_Position) := Radix_Point;
946 -- 1) Expand $, replace '.' with Radix_Point
948 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
949 Answer (Currency_Pos + 1 .. Answer'Last);
952 -- 2) No currency expansion, replace '.' with Radix_Point
957 elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix.
960 -- 3) Expand $, radix blanked
962 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
963 Answer (Currency_Pos + 1 .. Answer'Last);
966 -- 4) No expansion, radix blanked
978 return Answer (1 .. Pic.Radix_Position - 1) &
979 Answer (Pic.Radix_Position + 1 .. Answer'Last);
981 elsif Currency_Pos < Pic.Radix_Position then
983 -- 6) Expand $, Elide V
985 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
986 Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
987 Answer (Pic.Radix_Position + 1 .. Answer'Last);
990 -- 7) Elide V, Expand $
992 return Answer (1 .. Pic.Radix_Position - 1) &
993 Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
995 Answer (Currency_Pos + 1 .. Answer'Last);
1001 -- 8) No radix, expand $
1003 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
1004 Answer (Currency_Pos + 1 .. Answer'Last);
1007 -- 9) No radix, no currency expansion
1013 -------------------------
1014 -- Parse_Number_String --
1015 -------------------------
1017 function Parse_Number_String (Str : String) return Number_Attributes is
1018 Answer : Number_Attributes;
1021 for J in Str'Range loop
1029 -- Decide if this is the start of a number.
1030 -- If so, figure out which one...
1032 if Answer.Has_Fraction then
1033 Answer.End_Of_Fraction := J;
1035 if Answer.Start_Of_Int = Invalid_Position then
1037 Answer.Start_Of_Int := J;
1039 Answer.End_Of_Int := J;
1044 -- Only count a zero before the decimal point if it follows a
1045 -- non-zero digit. After the decimal point, zeros will be
1046 -- counted if followed by a non-zero digit.
1048 if not Answer.Has_Fraction then
1049 if Answer.Start_Of_Int /= Invalid_Position then
1050 Answer.End_Of_Int := J;
1058 Answer.Negative := True;
1062 -- Close integer, start fraction
1064 if Answer.Has_Fraction then
1065 raise Picture_Error;
1068 -- Two decimal points is a no-no
1070 Answer.Has_Fraction := True;
1071 Answer.End_Of_Fraction := J;
1073 -- Could leave this at Invalid_Position, but this seems the
1074 -- right way to indicate a null range...
1076 Answer.Start_Of_Fraction := J + 1;
1077 Answer.End_Of_Int := J - 1;
1080 raise Picture_Error; -- can this happen? probably not!
1084 if Answer.Start_Of_Int = Invalid_Position then
1085 Answer.Start_Of_Int := Answer.End_Of_Int + 1;
1088 -- No significant (intger) digits needs a null range
1091 end Parse_Number_String;
1097 -- The following ensures that we return B and not b being careful not
1098 -- to break things which expect lower case b for blank. See CXF3A02.
1100 function Pic_String (Pic : Picture) return String is
1101 Temp : String (1 .. Pic.Contents.Picture.Length) :=
1102 Pic.Contents.Picture.Expanded;
1104 for J in Temp'Range loop
1105 if Temp (J) = 'b' then
1117 procedure Precalculate (Pic : in out Format_Record) is
1119 Computed_BWZ : Boolean := True;
1121 type Legality is (Okay, Reject);
1122 State : Legality := Reject;
1123 -- Start in reject, which will reject null strings
1125 Index : Pic_Index := Pic.Picture.Expanded'First;
1127 function At_End return Boolean;
1128 pragma Inline (At_End);
1130 procedure Set_State (L : Legality);
1131 pragma Inline (Set_State);
1133 function Look return Character;
1134 pragma Inline (Look);
1136 function Is_Insert return Boolean;
1137 pragma Inline (Is_Insert);
1140 pragma Inline (Skip);
1142 procedure Trailing_Currency;
1143 procedure Trailing_Bracket;
1144 procedure Number_Fraction;
1145 procedure Number_Completion;
1146 procedure Number_Fraction_Or_Bracket;
1147 procedure Number_Fraction_Or_Z_Fill;
1148 procedure Zero_Suppression;
1149 procedure Floating_Bracket;
1150 procedure Number_Fraction_Or_Star_Fill;
1151 procedure Star_Suppression;
1152 procedure Number_Fraction_Or_Dollar;
1153 procedure Leading_Dollar;
1154 procedure Number_Fraction_Or_Pound;
1155 procedure Leading_Pound;
1157 procedure Floating_Plus;
1158 procedure Floating_Minus;
1159 procedure Picture_Plus;
1160 procedure Picture_Minus;
1161 procedure Picture_Bracket;
1163 procedure Optional_RHS_Sign;
1164 procedure Picture_String;
1170 function At_End return Boolean is
1172 return Index > Pic.Picture.Length;
1175 ----------------------
1176 -- Floating_Bracket --
1177 ----------------------
1179 -- Note that Floating_Bracket is only called with an acceptable
1180 -- prefix. But we don't set Okay, because we must end with a '>'.
1182 procedure Floating_Bracket is
1185 Pic.End_Float := Index;
1186 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1188 -- First bracket wasn't counted...
1199 when '_' | '0' | '/' =>
1200 Pic.End_Float := Index;
1204 Pic.End_Float := Index;
1205 Pic.Picture.Expanded (Index) := 'b';
1209 Pic.End_Float := Index;
1210 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1222 when 'V' | 'v' | '.' =>
1223 Pic.Radix_Position := Index;
1225 Number_Fraction_Or_Bracket;
1232 end Floating_Bracket;
1234 --------------------
1235 -- Floating_Minus --
1236 --------------------
1238 procedure Floating_Minus is
1246 when '_' | '0' | '/' =>
1247 Pic.End_Float := Index;
1251 Pic.End_Float := Index;
1252 Pic.Picture.Expanded (Index) := 'b';
1256 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1257 Pic.End_Float := Index;
1264 when '.' | 'V' | 'v' =>
1265 Pic.Radix_Position := Index;
1268 while Is_Insert loop
1285 Pic.Max_Trailing_Digits :=
1286 Pic.Max_Trailing_Digits + 1;
1287 Pic.End_Float := Index;
1290 when '_' | '0' | '/' =>
1294 Pic.Picture.Expanded (Index) := 'b';
1319 procedure Floating_Plus is
1327 when '_' | '0' | '/' =>
1328 Pic.End_Float := Index;
1332 Pic.End_Float := Index;
1333 Pic.Picture.Expanded (Index) := 'b';
1337 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1338 Pic.End_Float := Index;
1345 when '.' | 'V' | 'v' =>
1346 Pic.Radix_Position := Index;
1349 while Is_Insert loop
1366 Pic.Max_Trailing_Digits :=
1367 Pic.Max_Trailing_Digits + 1;
1368 Pic.End_Float := Index;
1371 when '_' | '0' | '/' =>
1375 Pic.Picture.Expanded (Index) := 'b';
1401 function Is_Insert return Boolean is
1407 case Pic.Picture.Expanded (Index) is
1409 when '_' | '0' | '/' => return True;
1412 Pic.Picture.Expanded (Index) := 'b'; -- canonical
1415 when others => return False;
1419 --------------------
1420 -- Leading_Dollar --
1421 --------------------
1423 -- Note that Leading_Dollar can be called in either State. It will set
1424 -- state to Okay only if a 9 or (second) is encountered.
1426 -- Also notice the tricky bit with State and Zero_Suppression.
1427 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1428 -- encountered, exactly the cases where State has been set.
1430 procedure Leading_Dollar is
1432 -- Treat as a floating dollar, and unwind otherwise
1435 Pic.Start_Currency := Index;
1436 Pic.End_Currency := Index;
1437 Pic.Start_Float := Index;
1438 Pic.End_Float := Index;
1440 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1452 when '_' | '0' | '/' =>
1453 Pic.End_Float := Index;
1456 -- A trailing insertion character is not part of the
1457 -- floating currency, so need to look ahead.
1460 Pic.End_Float := Pic.End_Float - 1;
1464 Pic.End_Float := Index;
1465 Pic.Picture.Expanded (Index) := 'b';
1469 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1471 if State = Okay then
1472 raise Picture_Error;
1474 -- Will overwrite Floater and Start_Float
1480 if State = Okay then
1481 raise Picture_Error;
1483 -- Will overwrite Floater and Start_Float
1489 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1490 Pic.End_Float := Index;
1491 Pic.End_Currency := Index;
1492 Set_State (Okay); Skip;
1495 if State /= Okay then
1497 Pic.Start_Float := Invalid_Position;
1498 Pic.End_Float := Invalid_Position;
1501 -- A single dollar does not a floating make
1506 when 'V' | 'v' | '.' =>
1507 if State /= Okay then
1509 Pic.Start_Float := Invalid_Position;
1510 Pic.End_Float := Invalid_Position;
1513 -- Only one dollar before the sign is okay, but doesn't
1516 Pic.Radix_Position := Index;
1518 Number_Fraction_Or_Dollar;
1532 -- This one is complex! A Leading_Pound can be fixed or floating,
1533 -- but in some cases the decision has to be deferred until we leave
1534 -- this procedure. Also note that Leading_Pound can be called in
1537 -- It will set state to Okay only if a 9 or (second) # is encountered
1539 -- One Last note: In ambiguous cases, the currency is treated as
1540 -- floating unless there is only one '#'.
1542 procedure Leading_Pound is
1544 Inserts : Boolean := False;
1545 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1547 Must_Float : Boolean := False;
1548 -- Set to true if a '#' occurs after an insert
1551 -- Treat as a floating currency. If it isn't, this will be
1552 -- overwritten later.
1556 Pic.Start_Currency := Index;
1557 Pic.End_Currency := Index;
1558 Pic.Start_Float := Index;
1559 Pic.End_Float := Index;
1561 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1564 Pic.Max_Currency_Digits := 1; -- we've seen one.
1575 when '_' | '0' | '/' =>
1576 Pic.End_Float := Index;
1581 Pic.Picture.Expanded (Index) := 'b';
1582 Pic.End_Float := Index;
1587 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1590 raise Picture_Error;
1592 Pic.Max_Leading_Digits := 0;
1594 -- Will overwrite Floater and Start_Float
1601 raise Picture_Error;
1603 Pic.Max_Leading_Digits := 0;
1605 -- Will overwrite Floater and Start_Float
1615 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1616 Pic.End_Float := Index;
1617 Pic.End_Currency := Index;
1622 if State /= Okay then
1624 -- A single '#' doesn't float
1627 Pic.Start_Float := Invalid_Position;
1628 Pic.End_Float := Invalid_Position;
1634 when 'V' | 'v' | '.' =>
1635 if State /= Okay then
1637 Pic.Start_Float := Invalid_Position;
1638 Pic.End_Float := Invalid_Position;
1641 -- Only one pound before the sign is okay, but doesn't
1644 Pic.Radix_Position := Index;
1646 Number_Fraction_Or_Pound;
1659 function Look return Character is
1662 raise Picture_Error;
1665 return Pic.Picture.Expanded (Index);
1677 when '_' | '0' | '/' =>
1681 Pic.Picture.Expanded (Index) := 'b';
1685 Computed_BWZ := False;
1686 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1690 when '.' | 'V' | 'v' =>
1691 Pic.Radix_Position := Index;
1705 -- Will return in Okay state if a '9' was seen
1710 -----------------------
1711 -- Number_Completion --
1712 -----------------------
1714 procedure Number_Completion is
1716 while not At_End loop
1719 when '_' | '0' | '/' =>
1723 Pic.Picture.Expanded (Index) := 'b';
1727 Computed_BWZ := False;
1728 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1732 when 'V' | 'v' | '.' =>
1733 Pic.Radix_Position := Index;
1742 end Number_Completion;
1744 ---------------------
1745 -- Number_Fraction --
1746 ---------------------
1748 procedure Number_Fraction is
1750 -- Note that number fraction can be called in either State.
1751 -- It will set state to Valid only if a 9 is encountered.
1759 when '_' | '0' | '/' =>
1763 Pic.Picture.Expanded (Index) := 'b';
1767 Computed_BWZ := False;
1768 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1769 Set_State (Okay); Skip;
1775 end Number_Fraction;
1777 --------------------------------
1778 -- Number_Fraction_Or_Bracket --
1779 --------------------------------
1781 procedure Number_Fraction_Or_Bracket is
1790 when '_' | '0' | '/' => Skip;
1793 Pic.Picture.Expanded (Index) := 'b';
1797 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1798 Pic.End_Float := Index;
1807 when '_' | '0' | '/' =>
1811 Pic.Picture.Expanded (Index) := 'b';
1815 Pic.Max_Trailing_Digits :=
1816 Pic.Max_Trailing_Digits + 1;
1817 Pic.End_Float := Index;
1830 end Number_Fraction_Or_Bracket;
1832 -------------------------------
1833 -- Number_Fraction_Or_Dollar --
1834 -------------------------------
1836 procedure Number_Fraction_Or_Dollar is
1844 when '_' | '0' | '/' =>
1848 Pic.Picture.Expanded (Index) := 'b';
1852 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1853 Pic.End_Float := Index;
1862 when '_' | '0' | '/' =>
1866 Pic.Picture.Expanded (Index) := 'b';
1870 Pic.Max_Trailing_Digits :=
1871 Pic.Max_Trailing_Digits + 1;
1872 Pic.End_Float := Index;
1885 end Number_Fraction_Or_Dollar;
1887 ------------------------------
1888 -- Number_Fraction_Or_Pound --
1889 ------------------------------
1891 procedure Number_Fraction_Or_Pound is
1900 when '_' | '0' | '/' =>
1904 Pic.Picture.Expanded (Index) := 'b';
1908 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1909 Pic.End_Float := Index;
1919 when '_' | '0' | '/' =>
1923 Pic.Picture.Expanded (Index) := 'b';
1927 Pic.Max_Trailing_Digits :=
1928 Pic.Max_Trailing_Digits + 1;
1929 Pic.End_Float := Index;
1944 end Number_Fraction_Or_Pound;
1946 ----------------------------------
1947 -- Number_Fraction_Or_Star_Fill --
1948 ----------------------------------
1950 procedure Number_Fraction_Or_Star_Fill is
1959 when '_' | '0' | '/' =>
1963 Pic.Picture.Expanded (Index) := 'b';
1967 Pic.Star_Fill := True;
1968 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1969 Pic.End_Float := Index;
1979 when '_' | '0' | '/' =>
1983 Pic.Picture.Expanded (Index) := 'b';
1987 Pic.Star_Fill := True;
1988 Pic.Max_Trailing_Digits :=
1989 Pic.Max_Trailing_Digits + 1;
1990 Pic.End_Float := Index;
2004 end Number_Fraction_Or_Star_Fill;
2006 -------------------------------
2007 -- Number_Fraction_Or_Z_Fill --
2008 -------------------------------
2010 procedure Number_Fraction_Or_Z_Fill is
2019 when '_' | '0' | '/' =>
2023 Pic.Picture.Expanded (Index) := 'b';
2027 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
2028 Pic.End_Float := Index;
2029 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2040 when '_' | '0' | '/' =>
2044 Pic.Picture.Expanded (Index) := 'b';
2048 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2050 Pic.Max_Trailing_Digits :=
2051 Pic.Max_Trailing_Digits + 1;
2052 Pic.End_Float := Index;
2065 end Number_Fraction_Or_Z_Fill;
2067 -----------------------
2068 -- Optional_RHS_Sign --
2069 -----------------------
2071 procedure Optional_RHS_Sign is
2080 Pic.Sign_Position := Index;
2085 Pic.Sign_Position := Index;
2086 Pic.Picture.Expanded (Index) := 'C';
2089 if Look = 'R' or Look = 'r' then
2090 Pic.Second_Sign := Index;
2091 Pic.Picture.Expanded (Index) := 'R';
2095 raise Picture_Error;
2101 Pic.Sign_Position := Index;
2102 Pic.Picture.Expanded (Index) := 'D';
2105 if Look = 'B' or Look = 'b' then
2106 Pic.Second_Sign := Index;
2107 Pic.Picture.Expanded (Index) := 'B';
2111 raise Picture_Error;
2117 if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
2118 Pic.Second_Sign := Index;
2122 raise Picture_Error;
2129 end Optional_RHS_Sign;
2135 -- Note that Picture can be called in either State
2137 -- It will set state to Valid only if a 9 is encountered or floating
2138 -- currency is called.
2140 procedure Picture is
2149 when '_' | '0' | '/' =>
2153 Pic.Picture.Expanded (Index) := 'b';
2165 Computed_BWZ := False;
2167 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2170 when 'V' | 'v' | '.' =>
2171 Pic.Radix_Position := Index;
2184 ---------------------
2185 -- Picture_Bracket --
2186 ---------------------
2188 procedure Picture_Bracket is
2190 Pic.Sign_Position := Index;
2191 Pic.Sign_Position := Index;
2193 -- Treat as a floating sign, and unwind otherwise
2196 Pic.Start_Float := Index;
2197 Pic.End_Float := Index;
2199 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2202 Skip; -- Known Bracket
2207 when '_' | '0' | '/' =>
2208 Pic.End_Float := Index;
2212 Pic.End_Float := Index;
2213 Pic.Picture.Expanded (Index) := 'b';
2217 Set_State (Okay); -- "<<>" is enough.
2223 when '$' | '#' | '9' | '*' =>
2224 if State /= Okay then
2226 Pic.Start_Float := Invalid_Position;
2227 Pic.End_Float := Invalid_Position;
2235 when '.' | 'V' | 'v' =>
2236 if State /= Okay then
2238 Pic.Start_Float := Invalid_Position;
2239 Pic.End_Float := Invalid_Position;
2242 -- Don't assume that state is okay, haven't seen a digit
2249 raise Picture_Error;
2253 end Picture_Bracket;
2259 procedure Picture_Minus is
2261 Pic.Sign_Position := Index;
2263 -- Treat as a floating sign, and unwind otherwise
2266 Pic.Start_Float := Index;
2267 Pic.End_Float := Index;
2269 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2272 Skip; -- Known Minus
2277 when '_' | '0' | '/' =>
2278 Pic.End_Float := Index;
2282 Pic.End_Float := Index;
2283 Pic.Picture.Expanded (Index) := 'b';
2287 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2288 Pic.End_Float := Index;
2290 Set_State (Okay); -- "-- " is enough.
2295 when '$' | '#' | '9' | '*' =>
2296 if State /= Okay then
2298 Pic.Start_Float := Invalid_Position;
2299 Pic.End_Float := Invalid_Position;
2308 -- Can't have Z and a floating sign
2310 if State = Okay then
2314 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2320 when '.' | 'V' | 'v' =>
2321 if State /= Okay then
2323 Pic.Start_Float := Invalid_Position;
2324 Pic.End_Float := Invalid_Position;
2327 -- Don't assume that state is okay, haven't seen a digit
2343 procedure Picture_Plus is
2345 Pic.Sign_Position := Index;
2347 -- Treat as a floating sign, and unwind otherwise
2350 Pic.Start_Float := Index;
2351 Pic.End_Float := Index;
2353 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2361 when '_' | '0' | '/' =>
2362 Pic.End_Float := Index;
2366 Pic.End_Float := Index;
2367 Pic.Picture.Expanded (Index) := 'b';
2371 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2372 Pic.End_Float := Index;
2374 Set_State (Okay); -- "++" is enough
2379 when '$' | '#' | '9' | '*' =>
2380 if State /= Okay then
2382 Pic.Start_Float := Invalid_Position;
2383 Pic.End_Float := Invalid_Position;
2391 if State = Okay then
2395 -- Can't have Z and a floating sign
2397 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2399 -- '+Z' is acceptable
2408 when '.' | 'V' | 'v' =>
2409 if State /= Okay then
2411 Pic.Start_Float := Invalid_Position;
2412 Pic.End_Float := Invalid_Position;
2415 -- Don't assume that state is okay, haven't seen a digit
2427 --------------------
2428 -- Picture_String --
2429 --------------------
2431 procedure Picture_String is
2433 while Is_Insert loop
2453 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2463 when '9' | '.' | 'V' | 'v' =>
2469 raise Picture_Error;
2473 -- Blank when zero either if the PIC does not contain a '9' or if
2474 -- requested by the user and no '*'
2476 Pic.Blank_When_Zero :=
2477 (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
2479 -- Star fill if '*' and no '9'
2481 Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
2493 procedure Set_State (L : Legality) is
2507 ----------------------
2508 -- Star_Suppression --
2509 ----------------------
2511 procedure Star_Suppression is
2514 Pic.Start_Float := Index;
2515 Pic.End_Float := Index;
2516 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2519 -- Even a single * is a valid picture
2521 Pic.Star_Fill := True;
2531 when '_' | '0' | '/' =>
2532 Pic.End_Float := Index;
2536 Pic.End_Float := Index;
2537 Pic.Picture.Expanded (Index) := 'b';
2541 Pic.End_Float := Index;
2542 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2543 Set_State (Okay); Skip;
2550 when '.' | 'V' | 'v' =>
2551 Pic.Radix_Position := Index;
2553 Number_Fraction_Or_Star_Fill;
2561 when others => raise Picture_Error;
2564 end Star_Suppression;
2566 ----------------------
2567 -- Trailing_Bracket --
2568 ----------------------
2570 procedure Trailing_Bracket is
2573 Pic.Second_Sign := Index;
2576 raise Picture_Error;
2578 end Trailing_Bracket;
2580 -----------------------
2581 -- Trailing_Currency --
2582 -----------------------
2584 procedure Trailing_Currency is
2591 Pic.Start_Currency := Index;
2592 Pic.End_Currency := Index;
2596 while not At_End and then Look = '#' loop
2597 if Pic.Start_Currency = Invalid_Position then
2598 Pic.Start_Currency := Index;
2601 Pic.End_Currency := Index;
2612 when '_' | '0' | '/' => Skip;
2615 Pic.Picture.Expanded (Index) := 'b';
2618 when others => return;
2621 end Trailing_Currency;
2623 ----------------------
2624 -- Zero_Suppression --
2625 ----------------------
2627 procedure Zero_Suppression is
2630 Pic.Start_Float := Index;
2631 Pic.End_Float := Index;
2632 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2633 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2638 -- Even a single Z is a valid picture
2646 when '_' | '0' | '/' =>
2647 Pic.End_Float := Index;
2651 Pic.End_Float := Index;
2652 Pic.Picture.Expanded (Index) := 'b';
2656 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2658 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2659 Pic.End_Float := Index;
2668 when '.' | 'V' | 'v' =>
2669 Pic.Radix_Position := Index;
2671 Number_Fraction_Or_Z_Fill;
2683 end Zero_Suppression;
2685 -- Start of processing for Precalculate
2690 if State = Reject then
2691 raise Picture_Error;
2696 when Constraint_Error =>
2698 -- To deal with special cases like null strings
2700 raise Picture_Error;
2709 (Pic_String : String;
2710 Blank_When_Zero : Boolean := False) return Picture
2716 Item : constant String := Expand (Pic_String);
2719 Result.Contents.Picture := (Item'Length, Item);
2720 Result.Contents.Original_BWZ := Blank_When_Zero;
2721 Result.Contents.Blank_When_Zero := Blank_When_Zero;
2722 Precalculate (Result.Contents);
2728 raise Picture_Error;
2736 function To_Wide (C : Character) return Wide_Wide_Character is
2738 return Wide_Wide_Character'Val (Character'Pos (C));
2746 (Pic_String : String;
2747 Blank_When_Zero : Boolean := False) return Boolean
2751 Expanded_Pic : constant String := Expand (Pic_String);
2752 -- Raises Picture_Error if Item not well-formed
2754 Format_Rec : Format_Record;
2757 Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2758 Format_Rec.Blank_When_Zero := Blank_When_Zero;
2759 Format_Rec.Original_BWZ := Blank_When_Zero;
2760 Precalculate (Format_Rec);
2762 -- False only if Blank_When_0 is True but the pic string has a '*'
2764 return not Blank_When_Zero
2765 or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2769 when others => return False;
2772 end Ada.Wide_Wide_Text_IO.Editing;