1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . W I D E _ T E X T _ I O . E D I T I N G --
9 -- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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_Fixed;
37 package body Ada.Wide_Text_IO.Editing is
39 package Strings renames Ada.Strings;
40 package Strings_Fixed renames Ada.Strings.Fixed;
41 package Strings_Wide_Fixed renames Ada.Strings.Wide_Fixed;
42 package Wide_Text_IO renames Ada.Wide_Text_IO;
44 -----------------------
45 -- Local_Subprograms --
46 -----------------------
48 function To_Wide (C : Character) return Wide_Character;
49 pragma Inline (To_Wide);
50 -- Convert Character to corresponding Wide_Character
56 function Blank_When_Zero (Pic : in Picture) return Boolean is
58 return Pic.Contents.Original_BWZ;
65 package body Decimal_Output is
74 Currency : in Wide_String := Default_Currency;
75 Fill : in Wide_Character := Default_Fill;
76 Separator : in Wide_Character := Default_Separator;
77 Radix_Mark : in Wide_Character := Default_Radix_Mark)
82 (Pic.Contents, Num'Image (Item),
83 Currency, Fill, Separator, Radix_Mark);
92 Currency : in Wide_String := Default_Currency)
95 Picstr : constant String := Pic_String (Pic);
96 V_Adjust : Integer := 0;
97 Cur_Adjust : Integer := 0;
100 -- Check if Picstr has 'V' or '$'
102 -- If 'V', then length is 1 less than otherwise
104 -- If '$', then length is Currency'Length-1 more than otherwise
106 -- This should use the string handling package ???
108 for J in Picstr'Range loop
109 if Picstr (J) = 'V' then
112 elsif Picstr (J) = '$' then
113 Cur_Adjust := Currency'Length - 1;
117 return Picstr'Length - V_Adjust + Cur_Adjust;
125 (File : in Wide_Text_IO.File_Type;
128 Currency : in Wide_String := Default_Currency;
129 Fill : in Wide_Character := Default_Fill;
130 Separator : in Wide_Character := Default_Separator;
131 Radix_Mark : in Wide_Character := Default_Radix_Mark)
134 Wide_Text_IO.Put (File, Image (Item, Pic,
135 Currency, Fill, Separator, Radix_Mark));
141 Currency : in Wide_String := Default_Currency;
142 Fill : in Wide_Character := Default_Fill;
143 Separator : in Wide_Character := Default_Separator;
144 Radix_Mark : in Wide_Character := Default_Radix_Mark)
147 Wide_Text_IO.Put (Image (Item, Pic,
148 Currency, Fill, Separator, Radix_Mark));
152 (To : out Wide_String;
155 Currency : in Wide_String := Default_Currency;
156 Fill : in Wide_Character := Default_Fill;
157 Separator : in Wide_Character := Default_Separator;
158 Radix_Mark : in Wide_Character := Default_Radix_Mark)
160 Result : constant Wide_String :=
161 Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
164 if Result'Length > To'Length then
165 raise Wide_Text_IO.Layout_Error;
167 Strings_Wide_Fixed.Move (Source => Result, Target => To,
168 Justify => Strings.Right);
179 Currency : in Wide_String := Default_Currency)
184 Temp : constant Wide_String := Image (Item, Pic, Currency);
185 pragma Warnings (Off, Temp);
192 when Layout_Error => return False;
202 function Expand (Picture : in String) return String is
203 Result : String (1 .. MAX_PICSIZE);
204 Picture_Index : Integer := Picture'First;
205 Result_Index : Integer := Result'First;
210 if Picture'Length < 1 then
214 if Picture (Picture'First) = '(' then
219 case Picture (Picture_Index) is
223 -- We now need to scan out the count after a left paren.
224 -- In the non-wide version we used Integer_IO.Get, but
225 -- that is not convenient here, since we don't want to
226 -- drag in normal Text_IO just for this purpose. So we
227 -- do the scan ourselves, with the normal validity checks.
229 Last := Picture_Index + 1;
232 if Picture (Last) not in '0' .. '9' then
236 Count := Character'Pos (Picture (Last)) - Character'Pos ('0');
240 if Last > Picture'Last then
244 if Picture (Last) = '_' then
245 if Picture (Last - 1) = '_' then
249 elsif Picture (Last) = ')' then
252 elsif Picture (Last) not in '0' .. '9' then
257 + Character'Pos (Picture (Last)) -
264 -- In what follows note that one copy of the repeated
265 -- character has already been made, so a count of one is a
266 -- no-op, and a count of zero erases a character.
268 for J in 2 .. Count loop
269 Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
272 Result_Index := Result_Index + Count - 1;
274 -- Last was a ')' throw it away too.
276 Picture_Index := Last + 1;
282 Result (Result_Index) := Picture (Picture_Index);
283 Picture_Index := Picture_Index + 1;
284 Result_Index := Result_Index + 1;
288 exit when Picture_Index > Picture'Last;
291 return Result (1 .. Result_Index - 1);
303 function Format_Number
304 (Pic : Format_Record;
306 Currency_Symbol : Wide_String;
307 Fill_Character : Wide_Character;
308 Separator_Character : Wide_Character;
309 Radix_Point : Wide_Character)
312 Attrs : Number_Attributes := Parse_Number_String (Number);
314 Rounded : String := Number;
316 Sign_Position : Integer := Pic.Sign_Position; -- may float.
318 Answer : Wide_String (1 .. Pic.Picture.Length);
320 Currency_Pos : Integer := Pic.Start_Currency;
322 Dollar : Boolean := False;
323 -- Overridden immediately if necessary.
325 Zero : Boolean := True;
326 -- Set to False when a non-zero digit is output.
330 -- If the picture has fewer decimal places than the number, the image
331 -- must be rounded according to the usual rules.
333 if Attrs.Has_Fraction then
335 R : constant Integer :=
336 (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
337 - Pic.Max_Trailing_Digits;
342 R_Pos := Rounded'Length - R;
344 if Rounded (R_Pos + 1) > '4' then
346 if Rounded (R_Pos) = '.' then
350 if Rounded (R_Pos) /= '9' then
351 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
353 Rounded (R_Pos) := '0';
357 if Rounded (R_Pos) = '.' then
361 if Rounded (R_Pos) /= '9' then
362 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
365 Rounded (R_Pos) := '0';
370 -- The rounding may add a digit in front. Either the
371 -- leading blank or the sign (already captured) can
375 Rounded (R_Pos) := '1';
376 Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
384 for J in Answer'Range loop
385 Answer (J) := To_Wide (Pic.Picture.Expanded (J));
388 if Pic.Start_Currency /= Invalid_Position then
389 Dollar := Answer (Pic.Start_Currency) = '$';
392 -- Fix up "direct inserts" outside the playing field. Set up as one
393 -- loop to do the beginning, one (reverse) loop to do the end.
397 exit when Last = Pic.Start_Float;
398 exit when Last = Pic.Radix_Position;
399 exit when Answer (Last) = '9';
401 case Answer (Last) is
404 Answer (Last) := Separator_Character;
407 Answer (Last) := ' ';
414 exit when Last = Answer'Last;
419 -- Now for the end...
421 for J in reverse Last .. Answer'Last loop
422 exit when J = Pic.Radix_Position;
424 -- Do this test First, Separator_Character can equal Pic.Floater.
426 if Answer (J) = Pic.Floater then
433 Answer (J) := Separator_Character;
449 if Pic.Start_Currency /= -1
450 and then Answer (Pic.Start_Currency) = '#'
451 and then Pic.Floater /= '#'
453 if Currency_Symbol'Length >
454 Pic.End_Currency - Pic.Start_Currency + 1
458 elsif Currency_Symbol'Length =
459 Pic.End_Currency - Pic.Start_Currency + 1
461 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
464 elsif Pic.Radix_Position = Invalid_Position
465 or else Pic.Start_Currency < Pic.Radix_Position
467 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
469 Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
470 Pic.End_Currency) := Currency_Symbol;
473 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
475 Answer (Pic.Start_Currency ..
476 Pic.Start_Currency + Currency_Symbol'Length - 1) :=
481 -- Fill in leading digits
483 if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
484 Pic.Max_Leading_Digits
489 if Pic.Radix_Position = Invalid_Position then
490 Position := Answer'Last;
492 Position := Pic.Radix_Position - 1;
495 for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
497 while Answer (Position) /= '9'
498 and Answer (Position) /= Pic.Floater
500 if Answer (Position) = '_' then
501 Answer (Position) := Separator_Character;
503 elsif Answer (Position) = 'b' then
504 Answer (Position) := ' ';
507 Position := Position - 1;
510 Answer (Position) := To_Wide (Rounded (J));
512 if Rounded (J) /= '0' then
516 Position := Position - 1;
521 if Pic.Start_Float = Invalid_Position then
523 -- No leading floats, but need to change '9' to '0', '_' to
524 -- Separator_Character and 'b' to ' '.
526 for J in Last .. Position loop
528 -- Last set when fixing the "uninteresting" leaders above.
529 -- Don't duplicate the work.
531 if Answer (J) = '9' then
534 elsif Answer (J) = '_' then
535 Answer (J) := Separator_Character;
537 elsif Answer (J) = 'b' then
544 elsif Pic.Floater = '<'
550 for J in Pic.End_Float .. Position loop -- May be null range.
551 if Answer (J) = '9' then
554 elsif Answer (J) = '_' then
555 Answer (J) := Separator_Character;
557 elsif Answer (J) = 'b' then
563 if Position > Pic.End_Float then
564 Position := Pic.End_Float;
567 for J in Pic.Start_Float .. Position - 1 loop
571 Answer (Position) := Pic.Floater;
572 Sign_Position := Position;
574 elsif Pic.Floater = '$' then
576 for J in Pic.End_Float .. Position loop -- May be null range.
577 if Answer (J) = '9' then
580 elsif Answer (J) = '_' then
581 Answer (J) := ' '; -- no separator before leftmost digit.
583 elsif Answer (J) = 'b' then
588 if Position > Pic.End_Float then
589 Position := Pic.End_Float;
592 for J in Pic.Start_Float .. Position - 1 loop
596 Answer (Position) := Pic.Floater;
597 Currency_Pos := Position;
599 elsif Pic.Floater = '*' then
601 for J in Pic.End_Float .. Position loop -- May be null range.
602 if Answer (J) = '9' then
605 elsif Answer (J) = '_' then
606 Answer (J) := Separator_Character;
608 elsif Answer (J) = 'b' then
613 if Position > Pic.End_Float then
614 Position := Pic.End_Float;
617 for J in Pic.Start_Float .. Position loop
622 if Pic.Floater = '#' then
623 Currency_Pos := Currency_Symbol'Length;
626 for J in reverse Pic.Start_Float .. Position loop
630 Answer (J) := Fill_Character;
632 when 'Z' | 'b' | '/' | '0' =>
638 when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
642 if Currency_Pos = 0 then
645 Answer (J) := Currency_Symbol (Currency_Pos);
646 Currency_Pos := Currency_Pos - 1;
654 Answer (J) := Fill_Character;
660 if Currency_Pos = 0 then
664 Answer (J) := Currency_Symbol (Currency_Pos);
665 Currency_Pos := Currency_Pos - 1;
679 if Pic.Floater = '#' and then Currency_Pos /= 0 then
686 if Sign_Position = Invalid_Position then
687 if Attrs.Negative then
692 if Attrs.Negative then
693 case Answer (Sign_Position) is
694 when 'C' | 'D' | '-' =>
698 Answer (Sign_Position) := '-';
701 Answer (Sign_Position) := '(';
702 Answer (Pic.Second_Sign) := ')';
711 case Answer (Sign_Position) is
714 Answer (Sign_Position) := ' ';
716 when '<' | 'C' | 'D' =>
717 Answer (Sign_Position) := ' ';
718 Answer (Pic.Second_Sign) := ' ';
730 -- Fill in trailing digits
732 if Pic.Max_Trailing_Digits > 0 then
734 if Attrs.Has_Fraction then
735 Position := Attrs.Start_Of_Fraction;
736 Last := Pic.Radix_Position + 1;
738 for J in Last .. Answer'Last loop
740 if Answer (J) = '9' or Answer (J) = Pic.Floater then
741 Answer (J) := To_Wide (Rounded (Position));
743 if Rounded (Position) /= '0' then
747 Position := Position + 1;
750 -- Used up fraction but remember place in Answer
752 exit when Position > Attrs.End_Of_Fraction;
754 elsif Answer (J) = 'b' then
757 elsif Answer (J) = '_' then
758 Answer (J) := Separator_Character;
768 Position := Pic.Radix_Position + 1;
771 -- Now fill remaining 9's with zeros and _ with separators
775 for J in Position .. Last loop
776 if Answer (J) = '9' then
779 elsif Answer (J) = Pic.Floater then
782 elsif Answer (J) = '_' then
783 Answer (J) := Separator_Character;
785 elsif Answer (J) = 'b' then
791 Position := Last + 1;
794 if Pic.Floater = '#' and then Currency_Pos /= 0 then
798 -- No trailing digits, but now J may need to stick in a currency
801 if Pic.Start_Currency = Invalid_Position then
802 Position := Answer'Last + 1;
804 Position := Pic.Start_Currency;
808 for J in Position .. Answer'Last loop
810 if Pic.Start_Currency /= Invalid_Position and then
811 Answer (Pic.Start_Currency) = '#' then
815 -- Note: There are some weird cases J can imagine with 'b' or '#'
816 -- in currency strings where the following code will cause
817 -- glitches. The trick is to tell when the character in the
818 -- answer should be checked, and when to look at the original
819 -- string. Some other time. RIE 11/26/96 ???
823 Answer (J) := Fill_Character;
829 if Currency_Pos > Currency_Symbol'Length then
833 Answer (J) := Currency_Symbol (Currency_Pos);
834 Currency_Pos := Currency_Pos + 1;
842 Answer (J) := Fill_Character;
848 if Currency_Pos > Currency_Symbol'Length then
851 Answer (J) := Currency_Symbol (Currency_Pos);
852 Currency_Pos := Currency_Pos + 1;
866 -- Now get rid of Blank_when_Zero and complete Star fill.
868 if Zero and Pic.Blank_When_Zero then
870 -- Value is zero, and blank it.
875 Last := Last - 1 + Currency_Symbol'Length;
878 if Pic.Radix_Position /= Invalid_Position and then
879 Answer (Pic.Radix_Position) = 'V' then
883 return Wide_String'(1 .. Last => ' ');
885 elsif Zero and Pic.Star_Fill then
889 Last := Last - 1 + Currency_Symbol'Length;
892 if Pic.Radix_Position /= Invalid_Position then
894 if Answer (Pic.Radix_Position) = 'V' then
898 if Pic.Radix_Position > Pic.Start_Currency then
899 return Wide_String' (1 .. Pic.Radix_Position - 1 => '*') &
901 Wide_String' (Pic.Radix_Position + 1 .. Last => '*');
907 Pic.Radix_Position + Currency_Symbol'Length - 2
911 (Pic.Radix_Position + Currency_Symbol'Length .. Last
917 Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
919 Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
923 return Wide_String' (1 .. Last => '*');
926 -- This was once a simple return statement, now there are nine
927 -- different return cases. Not to mention the five above to deal
928 -- with zeros. Why not split things out?
930 -- Processing the radix and sign expansion separately
931 -- would require lots of copying--the string and some of its
932 -- indices--without really simplifying the logic. The cases are:
934 -- 1) Expand $, replace '.' with Radix_Point
935 -- 2) No currency expansion, replace '.' with Radix_Point
936 -- 3) Expand $, radix blanked
937 -- 4) No currency expansion, radix blanked
939 -- 6) Expand $, Elide V
940 -- 7) Elide V, Expand $ (Two cases depending on order.)
941 -- 8) No radix, expand $
942 -- 9) No radix, no currency expansion
944 if Pic.Radix_Position /= Invalid_Position then
946 if Answer (Pic.Radix_Position) = '.' then
947 Answer (Pic.Radix_Position) := Radix_Point;
951 -- 1) Expand $, replace '.' with Radix_Point
953 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
954 Answer (Currency_Pos + 1 .. Answer'Last);
957 -- 2) No currency expansion, replace '.' with Radix_Point
962 elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix.
965 -- 3) Expand $, radix blanked
967 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
968 Answer (Currency_Pos + 1 .. Answer'Last);
971 -- 4) No expansion, radix blanked
983 return Answer (1 .. Pic.Radix_Position - 1) &
984 Answer (Pic.Radix_Position + 1 .. Answer'Last);
986 elsif Currency_Pos < Pic.Radix_Position then
988 -- 6) Expand $, Elide V
990 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
991 Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
992 Answer (Pic.Radix_Position + 1 .. Answer'Last);
995 -- 7) Elide V, Expand $
997 return Answer (1 .. Pic.Radix_Position - 1) &
998 Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
1000 Answer (Currency_Pos + 1 .. Answer'Last);
1006 -- 8) No radix, expand $
1008 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
1009 Answer (Currency_Pos + 1 .. Answer'Last);
1012 -- 9) No radix, no currency expansion
1019 -------------------------
1020 -- Parse_Number_String --
1021 -------------------------
1023 function Parse_Number_String (Str : String) return Number_Attributes is
1024 Answer : Number_Attributes;
1027 for J in Str'Range loop
1035 -- Decide if this is the start of a number.
1036 -- If so, figure out which one...
1038 if Answer.Has_Fraction then
1039 Answer.End_Of_Fraction := J;
1041 if Answer.Start_Of_Int = Invalid_Position then
1043 Answer.Start_Of_Int := J;
1045 Answer.End_Of_Int := J;
1050 -- Only count a zero before the decimal point if it follows a
1051 -- non-zero digit. After the decimal point, zeros will be
1052 -- counted if followed by a non-zero digit.
1054 if not Answer.Has_Fraction then
1055 if Answer.Start_Of_Int /= Invalid_Position then
1056 Answer.End_Of_Int := J;
1064 Answer.Negative := True;
1068 -- Close integer, start fraction
1070 if Answer.Has_Fraction then
1071 raise Picture_Error;
1074 -- Two decimal points is a no-no.
1076 Answer.Has_Fraction := True;
1077 Answer.End_Of_Fraction := J;
1079 -- Could leave this at Invalid_Position, but this seems the
1080 -- right way to indicate a null range...
1082 Answer.Start_Of_Fraction := J + 1;
1083 Answer.End_Of_Int := J - 1;
1086 raise Picture_Error; -- can this happen? probably not!
1090 if Answer.Start_Of_Int = Invalid_Position then
1091 Answer.Start_Of_Int := Answer.End_Of_Int + 1;
1094 -- No significant (intger) digits needs a null range.
1098 end Parse_Number_String;
1104 -- The following ensures that we return B and not b being careful not
1105 -- to break things which expect lower case b for blank. See CXF3A02.
1107 function Pic_String (Pic : in Picture) return String is
1108 Temp : String (1 .. Pic.Contents.Picture.Length) :=
1109 Pic.Contents.Picture.Expanded;
1111 for J in Temp'Range loop
1112 if Temp (J) = 'b' then Temp (J) := 'B'; end if;
1122 procedure Precalculate (Pic : in out Format_Record) is
1124 Computed_BWZ : Boolean := True;
1126 type Legality is (Okay, Reject);
1127 State : Legality := Reject;
1128 -- Start in reject, which will reject null strings.
1130 Index : Pic_Index := Pic.Picture.Expanded'First;
1132 function At_End return Boolean;
1133 pragma Inline (At_End);
1135 procedure Set_State (L : Legality);
1136 pragma Inline (Set_State);
1138 function Look return Character;
1139 pragma Inline (Look);
1141 function Is_Insert return Boolean;
1142 pragma Inline (Is_Insert);
1145 pragma Inline (Skip);
1147 procedure Trailing_Currency;
1148 procedure Trailing_Bracket;
1149 procedure Number_Fraction;
1150 procedure Number_Completion;
1151 procedure Number_Fraction_Or_Bracket;
1152 procedure Number_Fraction_Or_Z_Fill;
1153 procedure Zero_Suppression;
1154 procedure Floating_Bracket;
1155 procedure Number_Fraction_Or_Star_Fill;
1156 procedure Star_Suppression;
1157 procedure Number_Fraction_Or_Dollar;
1158 procedure Leading_Dollar;
1159 procedure Number_Fraction_Or_Pound;
1160 procedure Leading_Pound;
1162 procedure Floating_Plus;
1163 procedure Floating_Minus;
1164 procedure Picture_Plus;
1165 procedure Picture_Minus;
1166 procedure Picture_Bracket;
1168 procedure Optional_RHS_Sign;
1169 procedure Picture_String;
1175 function At_End return Boolean is
1177 return Index > Pic.Picture.Length;
1180 ----------------------
1181 -- Floating_Bracket --
1182 ----------------------
1184 -- Note that Floating_Bracket is only called with an acceptable
1185 -- prefix. But we don't set Okay, because we must end with a '>'.
1187 procedure Floating_Bracket is
1190 Pic.End_Float := Index;
1191 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1193 -- First bracket wasn't counted...
1204 when '_' | '0' | '/' =>
1205 Pic.End_Float := Index;
1209 Pic.End_Float := Index;
1210 Pic.Picture.Expanded (Index) := 'b';
1214 Pic.End_Float := Index;
1215 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1227 when 'V' | 'v' | '.' =>
1228 Pic.Radix_Position := Index;
1230 Number_Fraction_Or_Bracket;
1237 end Floating_Bracket;
1239 --------------------
1240 -- Floating_Minus --
1241 --------------------
1243 procedure Floating_Minus is
1251 when '_' | '0' | '/' =>
1252 Pic.End_Float := Index;
1256 Pic.End_Float := Index;
1257 Pic.Picture.Expanded (Index) := 'b';
1261 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1262 Pic.End_Float := Index;
1269 when '.' | 'V' | 'v' =>
1270 Pic.Radix_Position := Index;
1273 while Is_Insert loop
1290 Pic.Max_Trailing_Digits :=
1291 Pic.Max_Trailing_Digits + 1;
1292 Pic.End_Float := Index;
1295 when '_' | '0' | '/' =>
1299 Pic.Picture.Expanded (Index) := 'b';
1324 procedure Floating_Plus is
1332 when '_' | '0' | '/' =>
1333 Pic.End_Float := Index;
1337 Pic.End_Float := Index;
1338 Pic.Picture.Expanded (Index) := 'b';
1342 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1343 Pic.End_Float := Index;
1350 when '.' | 'V' | 'v' =>
1351 Pic.Radix_Position := Index;
1354 while Is_Insert loop
1371 Pic.Max_Trailing_Digits :=
1372 Pic.Max_Trailing_Digits + 1;
1373 Pic.End_Float := Index;
1376 when '_' | '0' | '/' =>
1380 Pic.Picture.Expanded (Index) := 'b';
1406 function Is_Insert return Boolean is
1412 case Pic.Picture.Expanded (Index) is
1414 when '_' | '0' | '/' => return True;
1417 Pic.Picture.Expanded (Index) := 'b'; -- canonical
1420 when others => return False;
1424 --------------------
1425 -- Leading_Dollar --
1426 --------------------
1428 -- Note that Leading_Dollar can be called in either State.
1429 -- It will set state to Okay only if a 9 or (second) $
1432 -- Also notice the tricky bit with State and Zero_Suppression.
1433 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1434 -- encountered, exactly the cases where State has been set.
1436 procedure Leading_Dollar is
1438 -- Treat as a floating dollar, and unwind otherwise.
1441 Pic.Start_Currency := Index;
1442 Pic.End_Currency := Index;
1443 Pic.Start_Float := Index;
1444 Pic.End_Float := Index;
1446 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1458 when '_' | '0' | '/' =>
1459 Pic.End_Float := Index;
1462 -- A trailing insertion character is not part of the
1463 -- floating currency, so need to look ahead.
1466 Pic.End_Float := Pic.End_Float - 1;
1470 Pic.End_Float := Index;
1471 Pic.Picture.Expanded (Index) := 'b';
1475 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1477 if State = Okay then
1478 raise Picture_Error;
1480 -- Will overwrite Floater and Start_Float
1486 if State = Okay then
1487 raise Picture_Error;
1489 -- Will overwrite Floater and Start_Float
1495 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1496 Pic.End_Float := Index;
1497 Pic.End_Currency := Index;
1498 Set_State (Okay); Skip;
1501 if State /= Okay then
1503 Pic.Start_Float := Invalid_Position;
1504 Pic.End_Float := Invalid_Position;
1507 -- A single dollar does not a floating make.
1512 when 'V' | 'v' | '.' =>
1513 if State /= Okay then
1515 Pic.Start_Float := Invalid_Position;
1516 Pic.End_Float := Invalid_Position;
1519 -- Only one dollar before the sign is okay,
1520 -- but doesn't float.
1522 Pic.Radix_Position := Index;
1524 Number_Fraction_Or_Dollar;
1538 -- This one is complex! A Leading_Pound can be fixed or floating,
1539 -- but in some cases the decision has to be deferred until we leave
1540 -- this procedure. Also note that Leading_Pound can be called in
1543 -- It will set state to Okay only if a 9 or (second) # is
1546 -- One Last note: In ambiguous cases, the currency is treated as
1547 -- floating unless there is only one '#'.
1549 procedure Leading_Pound is
1551 Inserts : Boolean := False;
1552 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1554 Must_Float : Boolean := False;
1555 -- Set to true if a '#' occurs after an insert.
1558 -- Treat as a floating currency. If it isn't, this will be
1559 -- overwritten later.
1563 Pic.Start_Currency := Index;
1564 Pic.End_Currency := Index;
1565 Pic.Start_Float := Index;
1566 Pic.End_Float := Index;
1568 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1571 Pic.Max_Currency_Digits := 1; -- we've seen one.
1582 when '_' | '0' | '/' =>
1583 Pic.End_Float := Index;
1588 Pic.Picture.Expanded (Index) := 'b';
1589 Pic.End_Float := Index;
1594 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1597 raise Picture_Error;
1599 Pic.Max_Leading_Digits := 0;
1601 -- Will overwrite Floater and Start_Float
1608 raise Picture_Error;
1610 Pic.Max_Leading_Digits := 0;
1612 -- Will overwrite Floater and Start_Float
1622 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1623 Pic.End_Float := Index;
1624 Pic.End_Currency := Index;
1629 if State /= Okay then
1631 -- A single '#' doesn't float.
1634 Pic.Start_Float := Invalid_Position;
1635 Pic.End_Float := Invalid_Position;
1641 when 'V' | 'v' | '.' =>
1642 if State /= Okay then
1644 Pic.Start_Float := Invalid_Position;
1645 Pic.End_Float := Invalid_Position;
1648 -- Only one pound before the sign is okay,
1649 -- but doesn't float.
1651 Pic.Radix_Position := Index;
1653 Number_Fraction_Or_Pound;
1666 function Look return Character is
1669 raise Picture_Error;
1672 return Pic.Picture.Expanded (Index);
1684 when '_' | '0' | '/' =>
1688 Pic.Picture.Expanded (Index) := 'b';
1692 Computed_BWZ := False;
1693 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1697 when '.' | 'V' | 'v' =>
1698 Pic.Radix_Position := Index;
1712 -- Will return in Okay state if a '9' was seen.
1717 -----------------------
1718 -- Number_Completion --
1719 -----------------------
1721 procedure Number_Completion is
1723 while not At_End loop
1726 when '_' | '0' | '/' =>
1730 Pic.Picture.Expanded (Index) := 'b';
1734 Computed_BWZ := False;
1735 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1739 when 'V' | 'v' | '.' =>
1740 Pic.Radix_Position := Index;
1749 end Number_Completion;
1751 ---------------------
1752 -- Number_Fraction --
1753 ---------------------
1755 procedure Number_Fraction is
1757 -- Note that number fraction can be called in either State.
1758 -- It will set state to Valid only if a 9 is encountered.
1766 when '_' | '0' | '/' =>
1770 Pic.Picture.Expanded (Index) := 'b';
1774 Computed_BWZ := False;
1775 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1776 Set_State (Okay); Skip;
1782 end Number_Fraction;
1784 --------------------------------
1785 -- Number_Fraction_Or_Bracket --
1786 --------------------------------
1788 procedure Number_Fraction_Or_Bracket is
1797 when '_' | '0' | '/' => Skip;
1800 Pic.Picture.Expanded (Index) := 'b';
1804 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1805 Pic.End_Float := Index;
1814 when '_' | '0' | '/' =>
1818 Pic.Picture.Expanded (Index) := 'b';
1822 Pic.Max_Trailing_Digits :=
1823 Pic.Max_Trailing_Digits + 1;
1824 Pic.End_Float := Index;
1837 end Number_Fraction_Or_Bracket;
1839 -------------------------------
1840 -- Number_Fraction_Or_Dollar --
1841 -------------------------------
1843 procedure Number_Fraction_Or_Dollar is
1851 when '_' | '0' | '/' =>
1855 Pic.Picture.Expanded (Index) := 'b';
1859 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1860 Pic.End_Float := Index;
1869 when '_' | '0' | '/' =>
1873 Pic.Picture.Expanded (Index) := 'b';
1877 Pic.Max_Trailing_Digits :=
1878 Pic.Max_Trailing_Digits + 1;
1879 Pic.End_Float := Index;
1892 end Number_Fraction_Or_Dollar;
1894 ------------------------------
1895 -- Number_Fraction_Or_Pound --
1896 ------------------------------
1898 procedure Number_Fraction_Or_Pound is
1907 when '_' | '0' | '/' =>
1911 Pic.Picture.Expanded (Index) := 'b';
1915 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1916 Pic.End_Float := Index;
1926 when '_' | '0' | '/' =>
1930 Pic.Picture.Expanded (Index) := 'b';
1934 Pic.Max_Trailing_Digits :=
1935 Pic.Max_Trailing_Digits + 1;
1936 Pic.End_Float := Index;
1951 end Number_Fraction_Or_Pound;
1953 ----------------------------------
1954 -- Number_Fraction_Or_Star_Fill --
1955 ----------------------------------
1957 procedure Number_Fraction_Or_Star_Fill is
1966 when '_' | '0' | '/' =>
1970 Pic.Picture.Expanded (Index) := 'b';
1974 Pic.Star_Fill := True;
1975 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1976 Pic.End_Float := Index;
1986 when '_' | '0' | '/' =>
1990 Pic.Picture.Expanded (Index) := 'b';
1994 Pic.Star_Fill := True;
1995 Pic.Max_Trailing_Digits :=
1996 Pic.Max_Trailing_Digits + 1;
1997 Pic.End_Float := Index;
2011 end Number_Fraction_Or_Star_Fill;
2013 -------------------------------
2014 -- Number_Fraction_Or_Z_Fill --
2015 -------------------------------
2017 procedure Number_Fraction_Or_Z_Fill is
2026 when '_' | '0' | '/' =>
2030 Pic.Picture.Expanded (Index) := 'b';
2034 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
2035 Pic.End_Float := Index;
2036 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2047 when '_' | '0' | '/' =>
2051 Pic.Picture.Expanded (Index) := 'b';
2055 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2057 Pic.Max_Trailing_Digits :=
2058 Pic.Max_Trailing_Digits + 1;
2059 Pic.End_Float := Index;
2072 end Number_Fraction_Or_Z_Fill;
2074 -----------------------
2075 -- Optional_RHS_Sign --
2076 -----------------------
2078 procedure Optional_RHS_Sign is
2087 Pic.Sign_Position := Index;
2092 Pic.Sign_Position := Index;
2093 Pic.Picture.Expanded (Index) := 'C';
2096 if Look = 'R' or Look = 'r' then
2097 Pic.Second_Sign := Index;
2098 Pic.Picture.Expanded (Index) := 'R';
2102 raise Picture_Error;
2108 Pic.Sign_Position := Index;
2109 Pic.Picture.Expanded (Index) := 'D';
2112 if Look = 'B' or Look = 'b' then
2113 Pic.Second_Sign := Index;
2114 Pic.Picture.Expanded (Index) := 'B';
2118 raise Picture_Error;
2124 if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
2125 Pic.Second_Sign := Index;
2129 raise Picture_Error;
2136 end Optional_RHS_Sign;
2142 -- Note that Picture can be called in either State.
2144 -- It will set state to Valid only if a 9 is encountered or floating
2145 -- currency is called.
2147 procedure Picture is
2156 when '_' | '0' | '/' =>
2160 Pic.Picture.Expanded (Index) := 'b';
2172 Computed_BWZ := False;
2174 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2177 when 'V' | 'v' | '.' =>
2178 Pic.Radix_Position := Index;
2191 ---------------------
2192 -- Picture_Bracket --
2193 ---------------------
2195 procedure Picture_Bracket is
2197 Pic.Sign_Position := Index;
2198 Pic.Sign_Position := Index;
2200 -- Treat as a floating sign, and unwind otherwise.
2203 Pic.Start_Float := Index;
2204 Pic.End_Float := Index;
2206 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2209 Skip; -- Known Bracket
2214 when '_' | '0' | '/' =>
2215 Pic.End_Float := Index;
2219 Pic.End_Float := Index;
2220 Pic.Picture.Expanded (Index) := 'b';
2224 Set_State (Okay); -- "<<>" is enough.
2230 when '$' | '#' | '9' | '*' =>
2231 if State /= Okay then
2233 Pic.Start_Float := Invalid_Position;
2234 Pic.End_Float := Invalid_Position;
2242 when '.' | 'V' | 'v' =>
2243 if State /= Okay then
2245 Pic.Start_Float := Invalid_Position;
2246 Pic.End_Float := Invalid_Position;
2249 -- Don't assume that state is okay, haven't seen a digit
2256 raise Picture_Error;
2260 end Picture_Bracket;
2266 procedure Picture_Minus is
2268 Pic.Sign_Position := Index;
2270 -- Treat as a floating sign, and unwind otherwise.
2273 Pic.Start_Float := Index;
2274 Pic.End_Float := Index;
2276 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2279 Skip; -- Known Minus
2284 when '_' | '0' | '/' =>
2285 Pic.End_Float := Index;
2289 Pic.End_Float := Index;
2290 Pic.Picture.Expanded (Index) := 'b';
2294 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2295 Pic.End_Float := Index;
2297 Set_State (Okay); -- "-- " is enough.
2302 when '$' | '#' | '9' | '*' =>
2303 if State /= Okay then
2305 Pic.Start_Float := Invalid_Position;
2306 Pic.End_Float := Invalid_Position;
2315 -- Can't have Z and a floating sign.
2317 if State = Okay then
2321 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2327 when '.' | 'V' | 'v' =>
2328 if State /= Okay then
2330 Pic.Start_Float := Invalid_Position;
2331 Pic.End_Float := Invalid_Position;
2334 -- Don't assume that state is okay, haven't seen a digit.
2350 procedure Picture_Plus is
2352 Pic.Sign_Position := Index;
2354 -- Treat as a floating sign, and unwind otherwise.
2357 Pic.Start_Float := Index;
2358 Pic.End_Float := Index;
2360 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2368 when '_' | '0' | '/' =>
2369 Pic.End_Float := Index;
2373 Pic.End_Float := Index;
2374 Pic.Picture.Expanded (Index) := 'b';
2378 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2379 Pic.End_Float := Index;
2381 Set_State (Okay); -- "++" is enough.
2386 when '$' | '#' | '9' | '*' =>
2387 if State /= Okay then
2389 Pic.Start_Float := Invalid_Position;
2390 Pic.End_Float := Invalid_Position;
2398 if State = Okay then
2402 -- Can't have Z and a floating sign.
2404 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2406 -- '+Z' is acceptable
2415 when '.' | 'V' | 'v' =>
2416 if State /= Okay then
2418 Pic.Start_Float := Invalid_Position;
2419 Pic.End_Float := Invalid_Position;
2422 -- Don't assume that state is okay, haven't seen a digit.
2434 --------------------
2435 -- Picture_String --
2436 --------------------
2438 procedure Picture_String is
2440 while Is_Insert loop
2460 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2470 when '9' | '.' | 'V' | 'v' =>
2476 raise Picture_Error;
2480 -- Blank when zero either if the PIC does not contain a '9' or if
2481 -- requested by the user and no '*'
2483 Pic.Blank_When_Zero :=
2484 (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
2486 -- Star fill if '*' and no '9'.
2488 Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
2500 procedure Set_State (L : Legality) is
2514 ----------------------
2515 -- Star_Suppression --
2516 ----------------------
2518 procedure Star_Suppression is
2521 Pic.Start_Float := Index;
2522 Pic.End_Float := Index;
2523 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2526 -- Even a single * is a valid picture
2528 Pic.Star_Fill := True;
2538 when '_' | '0' | '/' =>
2539 Pic.End_Float := Index;
2543 Pic.End_Float := Index;
2544 Pic.Picture.Expanded (Index) := 'b';
2548 Pic.End_Float := Index;
2549 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2550 Set_State (Okay); Skip;
2557 when '.' | 'V' | 'v' =>
2558 Pic.Radix_Position := Index;
2560 Number_Fraction_Or_Star_Fill;
2568 when others => raise Picture_Error;
2571 end Star_Suppression;
2573 ----------------------
2574 -- Trailing_Bracket --
2575 ----------------------
2577 procedure Trailing_Bracket is
2580 Pic.Second_Sign := Index;
2583 raise Picture_Error;
2585 end Trailing_Bracket;
2587 -----------------------
2588 -- Trailing_Currency --
2589 -----------------------
2591 procedure Trailing_Currency is
2598 Pic.Start_Currency := Index;
2599 Pic.End_Currency := Index;
2603 while not At_End and then Look = '#' loop
2604 if Pic.Start_Currency = Invalid_Position then
2605 Pic.Start_Currency := Index;
2608 Pic.End_Currency := Index;
2619 when '_' | '0' | '/' => Skip;
2622 Pic.Picture.Expanded (Index) := 'b';
2625 when others => return;
2628 end Trailing_Currency;
2630 ----------------------
2631 -- Zero_Suppression --
2632 ----------------------
2634 procedure Zero_Suppression is
2637 Pic.Start_Float := Index;
2638 Pic.End_Float := Index;
2639 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2640 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2645 -- Even a single Z is a valid picture
2653 when '_' | '0' | '/' =>
2654 Pic.End_Float := Index;
2658 Pic.End_Float := Index;
2659 Pic.Picture.Expanded (Index) := 'b';
2663 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2665 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2666 Pic.End_Float := Index;
2675 when '.' | 'V' | 'v' =>
2676 Pic.Radix_Position := Index;
2678 Number_Fraction_Or_Z_Fill;
2690 end Zero_Suppression;
2692 -- Start of processing for Precalculate
2697 if State = Reject then
2698 raise Picture_Error;
2703 when Constraint_Error =>
2705 -- To deal with special cases like null strings.
2707 raise Picture_Error;
2716 (Pic_String : in String;
2717 Blank_When_Zero : in Boolean := False)
2724 Item : constant String := Expand (Pic_String);
2727 Result.Contents.Picture := (Item'Length, Item);
2728 Result.Contents.Original_BWZ := Blank_When_Zero;
2729 Result.Contents.Blank_When_Zero := Blank_When_Zero;
2730 Precalculate (Result.Contents);
2736 raise Picture_Error;
2744 function To_Wide (C : Character) return Wide_Character is
2746 return Wide_Character'Val (Character'Pos (C));
2754 (Pic_String : in String;
2755 Blank_When_Zero : in Boolean := False)
2760 Expanded_Pic : constant String := Expand (Pic_String);
2761 -- Raises Picture_Error if Item not well-formed
2763 Format_Rec : Format_Record;
2766 Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2767 Format_Rec.Blank_When_Zero := Blank_When_Zero;
2768 Format_Rec.Original_BWZ := Blank_When_Zero;
2769 Precalculate (Format_Rec);
2771 -- False only if Blank_When_0 is True but the pic string
2774 return not Blank_When_Zero or
2775 Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2779 when others => return False;
2783 end Ada.Wide_Text_IO.Editing;