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-2009, 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 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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Ada.Strings.Fixed;
33 with Ada.Strings.Wide_Wide_Fixed;
35 package body Ada.Wide_Wide_Text_IO.Editing is
37 package Strings renames Ada.Strings;
38 package Strings_Fixed renames Ada.Strings.Fixed;
39 package Strings_Wide_Wide_Fixed renames Ada.Strings.Wide_Wide_Fixed;
40 package Wide_Wide_Text_IO renames Ada.Wide_Wide_Text_IO;
42 -----------------------
43 -- Local_Subprograms --
44 -----------------------
46 function To_Wide (C : Character) return Wide_Wide_Character;
47 pragma Inline (To_Wide);
48 -- Convert Character to corresponding Wide_Wide_Character
54 function Blank_When_Zero (Pic : Picture) return Boolean is
56 return Pic.Contents.Original_BWZ;
63 package body Decimal_Output is
72 Currency : Wide_Wide_String := Default_Currency;
73 Fill : Wide_Wide_Character := Default_Fill;
74 Separator : Wide_Wide_Character := Default_Separator;
75 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark)
76 return Wide_Wide_String
80 (Pic.Contents, Num'Image (Item),
81 Currency, Fill, Separator, Radix_Mark);
90 Currency : Wide_Wide_String := Default_Currency) return Natural
92 Picstr : constant String := Pic_String (Pic);
93 V_Adjust : Integer := 0;
94 Cur_Adjust : Integer := 0;
97 -- Check if Picstr has 'V' or '$'
99 -- If 'V', then length is 1 less than otherwise
101 -- If '$', then length is Currency'Length-1 more than otherwise
103 -- This should use the string handling package ???
105 for J in Picstr'Range loop
106 if Picstr (J) = 'V' then
109 elsif Picstr (J) = '$' then
110 Cur_Adjust := Currency'Length - 1;
114 return Picstr'Length - V_Adjust + Cur_Adjust;
122 (File : Wide_Wide_Text_IO.File_Type;
125 Currency : Wide_Wide_String := Default_Currency;
126 Fill : Wide_Wide_Character := Default_Fill;
127 Separator : Wide_Wide_Character := Default_Separator;
128 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark)
131 Wide_Wide_Text_IO.Put (File, Image (Item, Pic,
132 Currency, Fill, Separator, Radix_Mark));
138 Currency : Wide_Wide_String := Default_Currency;
139 Fill : Wide_Wide_Character := Default_Fill;
140 Separator : Wide_Wide_Character := Default_Separator;
141 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark)
144 Wide_Wide_Text_IO.Put (Image (Item, Pic,
145 Currency, Fill, Separator, Radix_Mark));
149 (To : out Wide_Wide_String;
152 Currency : Wide_Wide_String := Default_Currency;
153 Fill : Wide_Wide_Character := Default_Fill;
154 Separator : Wide_Wide_Character := Default_Separator;
155 Radix_Mark : Wide_Wide_Character := Default_Radix_Mark)
157 Result : constant Wide_Wide_String :=
158 Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
161 if Result'Length > To'Length then
162 raise Wide_Wide_Text_IO.Layout_Error;
164 Strings_Wide_Wide_Fixed.Move (Source => Result, Target => To,
165 Justify => Strings.Right);
176 Currency : Wide_Wide_String := Default_Currency) return Boolean
180 Temp : constant Wide_Wide_String := Image (Item, Pic, Currency);
181 pragma Warnings (Off, Temp);
187 when Layout_Error => return False;
196 function Expand (Picture : String) return String is
197 Result : String (1 .. MAX_PICSIZE);
198 Picture_Index : Integer := Picture'First;
199 Result_Index : Integer := Result'First;
204 if Picture'Length < 1 then
208 if Picture (Picture'First) = '(' then
213 case Picture (Picture_Index) is
217 -- We now need to scan out the count after a left paren. In
218 -- the non-wide version we used Integer_IO.Get, but that is
219 -- not convenient here, since we don't want to drag in normal
220 -- Text_IO just for this purpose. So we do the scan ourselves,
221 -- with the normal validity checks.
223 Last := Picture_Index + 1;
226 if Picture (Last) not in '0' .. '9' then
230 Count := Character'Pos (Picture (Last)) - Character'Pos ('0');
234 if Last > Picture'Last then
238 if Picture (Last) = '_' then
239 if Picture (Last - 1) = '_' then
243 elsif Picture (Last) = ')' then
246 elsif Picture (Last) not in '0' .. '9' then
251 + Character'Pos (Picture (Last)) -
258 -- In what follows note that one copy of the repeated
259 -- character has already been made, so a count of one is
260 -- no-op, and a count of zero erases a character.
262 for J in 2 .. Count loop
263 Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
266 Result_Index := Result_Index + Count - 1;
268 -- Last was a ')' throw it away too
270 Picture_Index := Last + 1;
276 Result (Result_Index) := Picture (Picture_Index);
277 Picture_Index := Picture_Index + 1;
278 Result_Index := Result_Index + 1;
282 exit when Picture_Index > Picture'Last;
285 return Result (1 .. Result_Index - 1);
296 function Format_Number
297 (Pic : Format_Record;
299 Currency_Symbol : Wide_Wide_String;
300 Fill_Character : Wide_Wide_Character;
301 Separator_Character : Wide_Wide_Character;
302 Radix_Point : Wide_Wide_Character) return Wide_Wide_String
304 Attrs : Number_Attributes := Parse_Number_String (Number);
306 Rounded : String := Number;
308 Sign_Position : Integer := Pic.Sign_Position; -- may float.
310 Answer : Wide_Wide_String (1 .. Pic.Picture.Length);
312 Currency_Pos : Integer := Pic.Start_Currency;
314 Dollar : Boolean := False;
315 -- Overridden immediately if necessary
317 Zero : Boolean := True;
318 -- Set to False when a non-zero digit is output
322 -- If the picture has fewer decimal places than the number, the image
323 -- must be rounded according to the usual rules.
325 if Attrs.Has_Fraction then
327 R : constant Integer :=
328 (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
329 - Pic.Max_Trailing_Digits;
334 R_Pos := Rounded'Length - R;
336 if Rounded (R_Pos + 1) > '4' then
338 if Rounded (R_Pos) = '.' then
342 if Rounded (R_Pos) /= '9' then
343 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
345 Rounded (R_Pos) := '0';
349 if Rounded (R_Pos) = '.' then
353 if Rounded (R_Pos) /= '9' then
354 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
357 Rounded (R_Pos) := '0';
362 -- The rounding may add a digit in front. Either the
363 -- leading blank or the sign (already captured) can be
367 Rounded (R_Pos) := '1';
368 Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
376 for J in Answer'Range loop
377 Answer (J) := To_Wide (Pic.Picture.Expanded (J));
380 if Pic.Start_Currency /= Invalid_Position then
381 Dollar := Answer (Pic.Start_Currency) = '$';
384 -- Fix up "direct inserts" outside the playing field. Set up as one
385 -- loop to do the beginning, one (reverse) loop to do the end.
389 exit when Last = Pic.Start_Float;
390 exit when Last = Pic.Radix_Position;
391 exit when Answer (Last) = '9';
393 case Answer (Last) is
396 Answer (Last) := Separator_Character;
399 Answer (Last) := ' ';
406 exit when Last = Answer'Last;
411 -- Now for the end...
413 for J in reverse Last .. Answer'Last loop
414 exit when J = Pic.Radix_Position;
416 -- Do this test First, Separator_Character can equal Pic.Floater
418 if Answer (J) = Pic.Floater then
425 Answer (J) := Separator_Character;
441 if Pic.Start_Currency /= -1
442 and then Answer (Pic.Start_Currency) = '#'
443 and then Pic.Floater /= '#'
445 if Currency_Symbol'Length >
446 Pic.End_Currency - Pic.Start_Currency + 1
450 elsif Currency_Symbol'Length =
451 Pic.End_Currency - Pic.Start_Currency + 1
453 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
456 elsif Pic.Radix_Position = Invalid_Position
457 or else Pic.Start_Currency < Pic.Radix_Position
459 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
461 Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
462 Pic.End_Currency) := Currency_Symbol;
465 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
467 Answer (Pic.Start_Currency ..
468 Pic.Start_Currency + Currency_Symbol'Length - 1) :=
473 -- Fill in leading digits
475 if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
476 Pic.Max_Leading_Digits
482 (if Pic.Radix_Position = Invalid_Position then Answer'Last
483 else Pic.Radix_Position - 1);
485 for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
486 while Answer (Position) /= '9'
488 Answer (Position) /= Pic.Floater
490 if Answer (Position) = '_' then
491 Answer (Position) := Separator_Character;
492 elsif Answer (Position) = 'b' then
493 Answer (Position) := ' ';
496 Position := Position - 1;
499 Answer (Position) := To_Wide (Rounded (J));
501 if Rounded (J) /= '0' then
505 Position := Position - 1;
510 if Pic.Start_Float = Invalid_Position then
512 -- No leading floats, but need to change '9' to '0', '_' to
513 -- Separator_Character and 'b' to ' '.
515 for J in Last .. Position loop
517 -- Last set when fixing the "uninteresting" leaders above.
518 -- Don't duplicate the work.
520 if Answer (J) = '9' then
523 elsif Answer (J) = '_' then
524 Answer (J) := Separator_Character;
526 elsif Answer (J) = 'b' then
533 elsif Pic.Floater = '<'
539 for J in Pic.End_Float .. Position loop -- May be null range
540 if Answer (J) = '9' then
543 elsif Answer (J) = '_' then
544 Answer (J) := Separator_Character;
546 elsif Answer (J) = 'b' then
552 if Position > Pic.End_Float then
553 Position := Pic.End_Float;
556 for J in Pic.Start_Float .. Position - 1 loop
560 Answer (Position) := Pic.Floater;
561 Sign_Position := Position;
563 elsif Pic.Floater = '$' then
565 for J in Pic.End_Float .. Position loop -- May be null range
566 if Answer (J) = '9' then
569 elsif Answer (J) = '_' then
570 Answer (J) := ' '; -- no separator before leftmost digit
572 elsif Answer (J) = 'b' then
577 if Position > Pic.End_Float then
578 Position := Pic.End_Float;
581 for J in Pic.Start_Float .. Position - 1 loop
585 Answer (Position) := Pic.Floater;
586 Currency_Pos := Position;
588 elsif Pic.Floater = '*' then
590 for J in Pic.End_Float .. Position loop -- May be null range
591 if Answer (J) = '9' then
594 elsif Answer (J) = '_' then
595 Answer (J) := Separator_Character;
597 elsif Answer (J) = 'b' then
602 if Position > Pic.End_Float then
603 Position := Pic.End_Float;
606 for J in Pic.Start_Float .. Position loop
611 if Pic.Floater = '#' then
612 Currency_Pos := Currency_Symbol'Length;
615 for J in reverse Pic.Start_Float .. Position loop
619 Answer (J) := Fill_Character;
621 when 'Z' | 'b' | '/' | '0' =>
627 when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
631 if Currency_Pos = 0 then
634 Answer (J) := Currency_Symbol (Currency_Pos);
635 Currency_Pos := Currency_Pos - 1;
643 Answer (J) := Fill_Character;
649 if Currency_Pos = 0 then
653 Answer (J) := Currency_Symbol (Currency_Pos);
654 Currency_Pos := Currency_Pos - 1;
668 if Pic.Floater = '#' and then Currency_Pos /= 0 then
675 if Sign_Position = Invalid_Position then
676 if Attrs.Negative then
681 if Attrs.Negative then
682 case Answer (Sign_Position) is
683 when 'C' | 'D' | '-' =>
687 Answer (Sign_Position) := '-';
690 Answer (Sign_Position) := '(';
691 Answer (Pic.Second_Sign) := ')';
700 case Answer (Sign_Position) is
703 Answer (Sign_Position) := ' ';
705 when '<' | 'C' | 'D' =>
706 Answer (Sign_Position) := ' ';
707 Answer (Pic.Second_Sign) := ' ';
719 -- Fill in trailing digits
721 if Pic.Max_Trailing_Digits > 0 then
723 if Attrs.Has_Fraction then
724 Position := Attrs.Start_Of_Fraction;
725 Last := Pic.Radix_Position + 1;
727 for J in Last .. Answer'Last loop
729 if Answer (J) = '9' or else Answer (J) = Pic.Floater then
730 Answer (J) := To_Wide (Rounded (Position));
732 if Rounded (Position) /= '0' then
736 Position := Position + 1;
739 -- Used up fraction but remember place in Answer
741 exit when Position > Attrs.End_Of_Fraction;
743 elsif Answer (J) = 'b' then
746 elsif Answer (J) = '_' then
747 Answer (J) := Separator_Character;
757 Position := Pic.Radix_Position + 1;
760 -- Now fill remaining 9's with zeros and _ with separators
764 for J in Position .. Last loop
765 if Answer (J) = '9' then
768 elsif Answer (J) = Pic.Floater then
771 elsif Answer (J) = '_' then
772 Answer (J) := Separator_Character;
774 elsif Answer (J) = 'b' then
780 Position := Last + 1;
783 if Pic.Floater = '#' and then Currency_Pos /= 0 then
787 -- No trailing digits, but now J may need to stick in a currency
791 (if Pic.Start_Currency = Invalid_Position then Answer'Last + 1
792 else Pic.Start_Currency);
795 for J in Position .. Answer'Last loop
796 if Pic.Start_Currency /= Invalid_Position and then
797 Answer (Pic.Start_Currency) = '#' then
801 -- Note: There are some weird cases J can imagine with 'b' or '#'
802 -- in currency strings where the following code will cause
803 -- glitches. The trick is to tell when the character in the
804 -- answer should be checked, and when to look at the original
805 -- string. Some other time. RIE 11/26/96 ???
809 Answer (J) := Fill_Character;
815 if Currency_Pos > Currency_Symbol'Length then
819 Answer (J) := Currency_Symbol (Currency_Pos);
820 Currency_Pos := Currency_Pos + 1;
828 Answer (J) := Fill_Character;
834 if Currency_Pos > Currency_Symbol'Length then
837 Answer (J) := Currency_Symbol (Currency_Pos);
838 Currency_Pos := Currency_Pos + 1;
852 -- Now get rid of Blank_when_Zero and complete Star fill
854 if Zero and then Pic.Blank_When_Zero then
856 -- Value is zero, and blank it
861 Last := Last - 1 + Currency_Symbol'Length;
864 if Pic.Radix_Position /= Invalid_Position and then
865 Answer (Pic.Radix_Position) = 'V' then
869 return Wide_Wide_String'(1 .. Last => ' ');
871 elsif Zero and then Pic.Star_Fill then
875 Last := Last - 1 + Currency_Symbol'Length;
878 if Pic.Radix_Position /= Invalid_Position then
880 if Answer (Pic.Radix_Position) = 'V' then
884 if Pic.Radix_Position > Pic.Start_Currency then
886 Wide_Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
888 Wide_Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
894 Pic.Radix_Position + Currency_Symbol'Length - 2
898 (Pic.Radix_Position + Currency_Symbol'Length .. Last
904 Wide_Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
906 Wide_Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
910 return Wide_Wide_String'(1 .. Last => '*');
913 -- This was once a simple return statement, now there are nine
914 -- different return cases. Not to mention the five above to deal
915 -- with zeros. Why not split things out?
917 -- Processing the radix and sign expansion separately
918 -- would require lots of copying--the string and some of its
919 -- indicies--without really simplifying the logic. The cases are:
921 -- 1) Expand $, replace '.' with Radix_Point
922 -- 2) No currency expansion, replace '.' with Radix_Point
923 -- 3) Expand $, radix blanked
924 -- 4) No currency expansion, radix blanked
926 -- 6) Expand $, Elide V
927 -- 7) Elide V, Expand $ (Two cases depending on order.)
928 -- 8) No radix, expand $
929 -- 9) No radix, no currency expansion
931 if Pic.Radix_Position /= Invalid_Position then
933 if Answer (Pic.Radix_Position) = '.' then
934 Answer (Pic.Radix_Position) := Radix_Point;
938 -- 1) Expand $, replace '.' with Radix_Point
940 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
941 Answer (Currency_Pos + 1 .. Answer'Last);
944 -- 2) No currency expansion, replace '.' with Radix_Point
949 elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix.
952 -- 3) Expand $, radix blanked
954 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
955 Answer (Currency_Pos + 1 .. Answer'Last);
958 -- 4) No expansion, radix blanked
970 return Answer (1 .. Pic.Radix_Position - 1) &
971 Answer (Pic.Radix_Position + 1 .. Answer'Last);
973 elsif Currency_Pos < Pic.Radix_Position then
975 -- 6) Expand $, Elide V
977 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
978 Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
979 Answer (Pic.Radix_Position + 1 .. Answer'Last);
982 -- 7) Elide V, Expand $
984 return Answer (1 .. Pic.Radix_Position - 1) &
985 Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
987 Answer (Currency_Pos + 1 .. Answer'Last);
993 -- 8) No radix, expand $
995 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
996 Answer (Currency_Pos + 1 .. Answer'Last);
999 -- 9) No radix, no currency expansion
1005 -------------------------
1006 -- Parse_Number_String --
1007 -------------------------
1009 function Parse_Number_String (Str : String) return Number_Attributes is
1010 Answer : Number_Attributes;
1013 for J in Str'Range loop
1021 -- Decide if this is the start of a number.
1022 -- If so, figure out which one...
1024 if Answer.Has_Fraction then
1025 Answer.End_Of_Fraction := J;
1027 if Answer.Start_Of_Int = Invalid_Position then
1029 Answer.Start_Of_Int := J;
1031 Answer.End_Of_Int := J;
1036 -- Only count a zero before the decimal point if it follows a
1037 -- non-zero digit. After the decimal point, zeros will be
1038 -- counted if followed by a non-zero digit.
1040 if not Answer.Has_Fraction then
1041 if Answer.Start_Of_Int /= Invalid_Position then
1042 Answer.End_Of_Int := J;
1050 Answer.Negative := True;
1054 -- Close integer, start fraction
1056 if Answer.Has_Fraction then
1057 raise Picture_Error;
1060 -- Two decimal points is a no-no
1062 Answer.Has_Fraction := True;
1063 Answer.End_Of_Fraction := J;
1065 -- Could leave this at Invalid_Position, but this seems the
1066 -- right way to indicate a null range...
1068 Answer.Start_Of_Fraction := J + 1;
1069 Answer.End_Of_Int := J - 1;
1072 raise Picture_Error; -- can this happen? probably not!
1076 if Answer.Start_Of_Int = Invalid_Position then
1077 Answer.Start_Of_Int := Answer.End_Of_Int + 1;
1080 -- No significant (intger) digits needs a null range
1083 end Parse_Number_String;
1089 -- The following ensures that we return B and not b being careful not
1090 -- to break things which expect lower case b for blank. See CXF3A02.
1092 function Pic_String (Pic : Picture) return String is
1093 Temp : String (1 .. Pic.Contents.Picture.Length) :=
1094 Pic.Contents.Picture.Expanded;
1096 for J in Temp'Range loop
1097 if Temp (J) = 'b' then
1109 procedure Precalculate (Pic : in out Format_Record) is
1111 Computed_BWZ : Boolean := True;
1113 type Legality is (Okay, Reject);
1114 State : Legality := Reject;
1115 -- Start in reject, which will reject null strings
1117 Index : Pic_Index := Pic.Picture.Expanded'First;
1119 function At_End return Boolean;
1120 pragma Inline (At_End);
1122 procedure Set_State (L : Legality);
1123 pragma Inline (Set_State);
1125 function Look return Character;
1126 pragma Inline (Look);
1128 function Is_Insert return Boolean;
1129 pragma Inline (Is_Insert);
1132 pragma Inline (Skip);
1134 procedure Trailing_Currency;
1135 procedure Trailing_Bracket;
1136 procedure Number_Fraction;
1137 procedure Number_Completion;
1138 procedure Number_Fraction_Or_Bracket;
1139 procedure Number_Fraction_Or_Z_Fill;
1140 procedure Zero_Suppression;
1141 procedure Floating_Bracket;
1142 procedure Number_Fraction_Or_Star_Fill;
1143 procedure Star_Suppression;
1144 procedure Number_Fraction_Or_Dollar;
1145 procedure Leading_Dollar;
1146 procedure Number_Fraction_Or_Pound;
1147 procedure Leading_Pound;
1149 procedure Floating_Plus;
1150 procedure Floating_Minus;
1151 procedure Picture_Plus;
1152 procedure Picture_Minus;
1153 procedure Picture_Bracket;
1155 procedure Optional_RHS_Sign;
1156 procedure Picture_String;
1162 function At_End return Boolean is
1164 return Index > Pic.Picture.Length;
1167 ----------------------
1168 -- Floating_Bracket --
1169 ----------------------
1171 -- Note that Floating_Bracket is only called with an acceptable
1172 -- prefix. But we don't set Okay, because we must end with a '>'.
1174 procedure Floating_Bracket is
1177 Pic.End_Float := Index;
1178 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1180 -- First bracket wasn't counted...
1191 when '_' | '0' | '/' =>
1192 Pic.End_Float := Index;
1196 Pic.End_Float := Index;
1197 Pic.Picture.Expanded (Index) := 'b';
1201 Pic.End_Float := Index;
1202 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1214 when 'V' | 'v' | '.' =>
1215 Pic.Radix_Position := Index;
1217 Number_Fraction_Or_Bracket;
1224 end Floating_Bracket;
1226 --------------------
1227 -- Floating_Minus --
1228 --------------------
1230 procedure Floating_Minus is
1238 when '_' | '0' | '/' =>
1239 Pic.End_Float := Index;
1243 Pic.End_Float := Index;
1244 Pic.Picture.Expanded (Index) := 'b';
1248 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1249 Pic.End_Float := Index;
1256 when '.' | 'V' | 'v' =>
1257 Pic.Radix_Position := Index;
1260 while Is_Insert loop
1277 Pic.Max_Trailing_Digits :=
1278 Pic.Max_Trailing_Digits + 1;
1279 Pic.End_Float := Index;
1282 when '_' | '0' | '/' =>
1286 Pic.Picture.Expanded (Index) := 'b';
1311 procedure Floating_Plus is
1319 when '_' | '0' | '/' =>
1320 Pic.End_Float := Index;
1324 Pic.End_Float := Index;
1325 Pic.Picture.Expanded (Index) := 'b';
1329 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1330 Pic.End_Float := Index;
1337 when '.' | 'V' | 'v' =>
1338 Pic.Radix_Position := Index;
1341 while Is_Insert loop
1358 Pic.Max_Trailing_Digits :=
1359 Pic.Max_Trailing_Digits + 1;
1360 Pic.End_Float := Index;
1363 when '_' | '0' | '/' =>
1367 Pic.Picture.Expanded (Index) := 'b';
1393 function Is_Insert return Boolean is
1399 case Pic.Picture.Expanded (Index) is
1401 when '_' | '0' | '/' => return True;
1404 Pic.Picture.Expanded (Index) := 'b'; -- canonical
1407 when others => return False;
1411 --------------------
1412 -- Leading_Dollar --
1413 --------------------
1415 -- Note that Leading_Dollar can be called in either State. It will set
1416 -- state to Okay only if a 9 or (second) is encountered.
1418 -- Also notice the tricky bit with State and Zero_Suppression.
1419 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1420 -- encountered, exactly the cases where State has been set.
1422 procedure Leading_Dollar is
1424 -- Treat as a floating dollar, and unwind otherwise
1427 Pic.Start_Currency := Index;
1428 Pic.End_Currency := Index;
1429 Pic.Start_Float := Index;
1430 Pic.End_Float := Index;
1432 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1444 when '_' | '0' | '/' =>
1445 Pic.End_Float := Index;
1448 -- A trailing insertion character is not part of the
1449 -- floating currency, so need to look ahead.
1452 Pic.End_Float := Pic.End_Float - 1;
1456 Pic.End_Float := Index;
1457 Pic.Picture.Expanded (Index) := 'b';
1461 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1463 if State = Okay then
1464 raise Picture_Error;
1466 -- Will overwrite Floater and Start_Float
1472 if State = Okay then
1473 raise Picture_Error;
1475 -- Will overwrite Floater and Start_Float
1481 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1482 Pic.End_Float := Index;
1483 Pic.End_Currency := Index;
1484 Set_State (Okay); Skip;
1487 if State /= Okay then
1489 Pic.Start_Float := Invalid_Position;
1490 Pic.End_Float := Invalid_Position;
1493 -- A single dollar does not a floating make
1498 when 'V' | 'v' | '.' =>
1499 if State /= Okay then
1501 Pic.Start_Float := Invalid_Position;
1502 Pic.End_Float := Invalid_Position;
1505 -- Only one dollar before the sign is okay, but doesn't
1508 Pic.Radix_Position := Index;
1510 Number_Fraction_Or_Dollar;
1524 -- This one is complex! A Leading_Pound can be fixed or floating,
1525 -- but in some cases the decision has to be deferred until we leave
1526 -- this procedure. Also note that Leading_Pound can be called in
1529 -- It will set state to Okay only if a 9 or (second) # is encountered
1531 -- One Last note: In ambiguous cases, the currency is treated as
1532 -- floating unless there is only one '#'.
1534 procedure Leading_Pound is
1536 Inserts : Boolean := False;
1537 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1539 Must_Float : Boolean := False;
1540 -- Set to true if a '#' occurs after an insert
1543 -- Treat as a floating currency. If it isn't, this will be
1544 -- overwritten later.
1548 Pic.Start_Currency := Index;
1549 Pic.End_Currency := Index;
1550 Pic.Start_Float := Index;
1551 Pic.End_Float := Index;
1553 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1556 Pic.Max_Currency_Digits := 1; -- we've seen one.
1567 when '_' | '0' | '/' =>
1568 Pic.End_Float := Index;
1573 Pic.Picture.Expanded (Index) := 'b';
1574 Pic.End_Float := Index;
1579 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1582 raise Picture_Error;
1584 Pic.Max_Leading_Digits := 0;
1586 -- Will overwrite Floater and Start_Float
1593 raise Picture_Error;
1595 Pic.Max_Leading_Digits := 0;
1597 -- Will overwrite Floater and Start_Float
1607 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1608 Pic.End_Float := Index;
1609 Pic.End_Currency := Index;
1614 if State /= Okay then
1616 -- A single '#' doesn't float
1619 Pic.Start_Float := Invalid_Position;
1620 Pic.End_Float := Invalid_Position;
1626 when 'V' | 'v' | '.' =>
1627 if State /= Okay then
1629 Pic.Start_Float := Invalid_Position;
1630 Pic.End_Float := Invalid_Position;
1633 -- Only one pound before the sign is okay, but doesn't
1636 Pic.Radix_Position := Index;
1638 Number_Fraction_Or_Pound;
1651 function Look return Character is
1654 raise Picture_Error;
1657 return Pic.Picture.Expanded (Index);
1669 when '_' | '0' | '/' =>
1673 Pic.Picture.Expanded (Index) := 'b';
1677 Computed_BWZ := False;
1678 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1682 when '.' | 'V' | 'v' =>
1683 Pic.Radix_Position := Index;
1697 -- Will return in Okay state if a '9' was seen
1702 -----------------------
1703 -- Number_Completion --
1704 -----------------------
1706 procedure Number_Completion is
1708 while not At_End loop
1711 when '_' | '0' | '/' =>
1715 Pic.Picture.Expanded (Index) := 'b';
1719 Computed_BWZ := False;
1720 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1724 when 'V' | 'v' | '.' =>
1725 Pic.Radix_Position := Index;
1734 end Number_Completion;
1736 ---------------------
1737 -- Number_Fraction --
1738 ---------------------
1740 procedure Number_Fraction is
1742 -- Note that number fraction can be called in either State.
1743 -- It will set state to Valid only if a 9 is encountered.
1751 when '_' | '0' | '/' =>
1755 Pic.Picture.Expanded (Index) := 'b';
1759 Computed_BWZ := False;
1760 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1761 Set_State (Okay); Skip;
1767 end Number_Fraction;
1769 --------------------------------
1770 -- Number_Fraction_Or_Bracket --
1771 --------------------------------
1773 procedure Number_Fraction_Or_Bracket is
1782 when '_' | '0' | '/' => Skip;
1785 Pic.Picture.Expanded (Index) := 'b';
1789 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1790 Pic.End_Float := Index;
1799 when '_' | '0' | '/' =>
1803 Pic.Picture.Expanded (Index) := 'b';
1807 Pic.Max_Trailing_Digits :=
1808 Pic.Max_Trailing_Digits + 1;
1809 Pic.End_Float := Index;
1822 end Number_Fraction_Or_Bracket;
1824 -------------------------------
1825 -- Number_Fraction_Or_Dollar --
1826 -------------------------------
1828 procedure Number_Fraction_Or_Dollar is
1836 when '_' | '0' | '/' =>
1840 Pic.Picture.Expanded (Index) := 'b';
1844 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1845 Pic.End_Float := Index;
1854 when '_' | '0' | '/' =>
1858 Pic.Picture.Expanded (Index) := 'b';
1862 Pic.Max_Trailing_Digits :=
1863 Pic.Max_Trailing_Digits + 1;
1864 Pic.End_Float := Index;
1877 end Number_Fraction_Or_Dollar;
1879 ------------------------------
1880 -- Number_Fraction_Or_Pound --
1881 ------------------------------
1883 procedure Number_Fraction_Or_Pound is
1892 when '_' | '0' | '/' =>
1896 Pic.Picture.Expanded (Index) := 'b';
1900 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1901 Pic.End_Float := Index;
1911 when '_' | '0' | '/' =>
1915 Pic.Picture.Expanded (Index) := 'b';
1919 Pic.Max_Trailing_Digits :=
1920 Pic.Max_Trailing_Digits + 1;
1921 Pic.End_Float := Index;
1936 end Number_Fraction_Or_Pound;
1938 ----------------------------------
1939 -- Number_Fraction_Or_Star_Fill --
1940 ----------------------------------
1942 procedure Number_Fraction_Or_Star_Fill is
1951 when '_' | '0' | '/' =>
1955 Pic.Picture.Expanded (Index) := 'b';
1959 Pic.Star_Fill := True;
1960 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1961 Pic.End_Float := Index;
1971 when '_' | '0' | '/' =>
1975 Pic.Picture.Expanded (Index) := 'b';
1979 Pic.Star_Fill := True;
1980 Pic.Max_Trailing_Digits :=
1981 Pic.Max_Trailing_Digits + 1;
1982 Pic.End_Float := Index;
1996 end Number_Fraction_Or_Star_Fill;
1998 -------------------------------
1999 -- Number_Fraction_Or_Z_Fill --
2000 -------------------------------
2002 procedure Number_Fraction_Or_Z_Fill is
2011 when '_' | '0' | '/' =>
2015 Pic.Picture.Expanded (Index) := 'b';
2019 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
2020 Pic.End_Float := Index;
2021 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2032 when '_' | '0' | '/' =>
2036 Pic.Picture.Expanded (Index) := 'b';
2040 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2042 Pic.Max_Trailing_Digits :=
2043 Pic.Max_Trailing_Digits + 1;
2044 Pic.End_Float := Index;
2057 end Number_Fraction_Or_Z_Fill;
2059 -----------------------
2060 -- Optional_RHS_Sign --
2061 -----------------------
2063 procedure Optional_RHS_Sign is
2072 Pic.Sign_Position := Index;
2077 Pic.Sign_Position := Index;
2078 Pic.Picture.Expanded (Index) := 'C';
2081 if Look = 'R' or else Look = 'r' then
2082 Pic.Second_Sign := Index;
2083 Pic.Picture.Expanded (Index) := 'R';
2087 raise Picture_Error;
2093 Pic.Sign_Position := Index;
2094 Pic.Picture.Expanded (Index) := 'D';
2097 if Look = 'B' or else Look = 'b' then
2098 Pic.Second_Sign := Index;
2099 Pic.Picture.Expanded (Index) := 'B';
2103 raise Picture_Error;
2109 if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
2110 Pic.Second_Sign := Index;
2114 raise Picture_Error;
2121 end Optional_RHS_Sign;
2127 -- Note that Picture can be called in either State
2129 -- It will set state to Valid only if a 9 is encountered or floating
2130 -- currency is called.
2132 procedure Picture is
2141 when '_' | '0' | '/' =>
2145 Pic.Picture.Expanded (Index) := 'b';
2157 Computed_BWZ := False;
2159 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2162 when 'V' | 'v' | '.' =>
2163 Pic.Radix_Position := Index;
2176 ---------------------
2177 -- Picture_Bracket --
2178 ---------------------
2180 procedure Picture_Bracket is
2182 Pic.Sign_Position := Index;
2183 Pic.Sign_Position := Index;
2185 -- Treat as a floating sign, and unwind otherwise
2188 Pic.Start_Float := Index;
2189 Pic.End_Float := Index;
2191 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2194 Skip; -- Known Bracket
2199 when '_' | '0' | '/' =>
2200 Pic.End_Float := Index;
2204 Pic.End_Float := Index;
2205 Pic.Picture.Expanded (Index) := 'b';
2209 Set_State (Okay); -- "<<>" is enough.
2215 when '$' | '#' | '9' | '*' =>
2216 if State /= Okay then
2218 Pic.Start_Float := Invalid_Position;
2219 Pic.End_Float := Invalid_Position;
2227 when '.' | 'V' | 'v' =>
2228 if State /= Okay then
2230 Pic.Start_Float := Invalid_Position;
2231 Pic.End_Float := Invalid_Position;
2234 -- Don't assume that state is okay, haven't seen a digit
2241 raise Picture_Error;
2245 end Picture_Bracket;
2251 procedure Picture_Minus is
2253 Pic.Sign_Position := Index;
2255 -- Treat as a floating sign, and unwind otherwise
2258 Pic.Start_Float := Index;
2259 Pic.End_Float := Index;
2261 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2264 Skip; -- Known Minus
2269 when '_' | '0' | '/' =>
2270 Pic.End_Float := Index;
2274 Pic.End_Float := Index;
2275 Pic.Picture.Expanded (Index) := 'b';
2279 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2280 Pic.End_Float := Index;
2282 Set_State (Okay); -- "-- " is enough.
2287 when '$' | '#' | '9' | '*' =>
2288 if State /= Okay then
2290 Pic.Start_Float := Invalid_Position;
2291 Pic.End_Float := Invalid_Position;
2300 -- Can't have Z and a floating sign
2302 if State = Okay then
2306 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2312 when '.' | 'V' | 'v' =>
2313 if State /= Okay then
2315 Pic.Start_Float := Invalid_Position;
2316 Pic.End_Float := Invalid_Position;
2319 -- Don't assume that state is okay, haven't seen a digit
2335 procedure Picture_Plus is
2337 Pic.Sign_Position := Index;
2339 -- Treat as a floating sign, and unwind otherwise
2342 Pic.Start_Float := Index;
2343 Pic.End_Float := Index;
2345 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2353 when '_' | '0' | '/' =>
2354 Pic.End_Float := Index;
2358 Pic.End_Float := Index;
2359 Pic.Picture.Expanded (Index) := 'b';
2363 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2364 Pic.End_Float := Index;
2366 Set_State (Okay); -- "++" is enough
2371 when '$' | '#' | '9' | '*' =>
2372 if State /= Okay then
2374 Pic.Start_Float := Invalid_Position;
2375 Pic.End_Float := Invalid_Position;
2383 if State = Okay then
2387 -- Can't have Z and a floating sign
2389 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2391 -- '+Z' is acceptable
2400 when '.' | 'V' | 'v' =>
2401 if State /= Okay then
2403 Pic.Start_Float := Invalid_Position;
2404 Pic.End_Float := Invalid_Position;
2407 -- Don't assume that state is okay, haven't seen a digit
2419 --------------------
2420 -- Picture_String --
2421 --------------------
2423 procedure Picture_String is
2425 while Is_Insert loop
2445 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2455 when '9' | '.' | 'V' | 'v' =>
2461 raise Picture_Error;
2465 -- Blank when zero either if the PIC does not contain a '9' or if
2466 -- requested by the user and no '*'.
2468 Pic.Blank_When_Zero :=
2469 (Computed_BWZ or else Pic.Blank_When_Zero)
2470 and then not Pic.Star_Fill;
2472 -- Star fill if '*' and no '9'
2474 Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ;
2486 procedure Set_State (L : Legality) is
2500 ----------------------
2501 -- Star_Suppression --
2502 ----------------------
2504 procedure Star_Suppression is
2507 Pic.Start_Float := Index;
2508 Pic.End_Float := Index;
2509 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2512 -- Even a single * is a valid picture
2514 Pic.Star_Fill := True;
2524 when '_' | '0' | '/' =>
2525 Pic.End_Float := Index;
2529 Pic.End_Float := Index;
2530 Pic.Picture.Expanded (Index) := 'b';
2534 Pic.End_Float := Index;
2535 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2536 Set_State (Okay); Skip;
2543 when '.' | 'V' | 'v' =>
2544 Pic.Radix_Position := Index;
2546 Number_Fraction_Or_Star_Fill;
2554 when others => raise Picture_Error;
2557 end Star_Suppression;
2559 ----------------------
2560 -- Trailing_Bracket --
2561 ----------------------
2563 procedure Trailing_Bracket is
2566 Pic.Second_Sign := Index;
2569 raise Picture_Error;
2571 end Trailing_Bracket;
2573 -----------------------
2574 -- Trailing_Currency --
2575 -----------------------
2577 procedure Trailing_Currency is
2584 Pic.Start_Currency := Index;
2585 Pic.End_Currency := Index;
2589 while not At_End and then Look = '#' loop
2590 if Pic.Start_Currency = Invalid_Position then
2591 Pic.Start_Currency := Index;
2594 Pic.End_Currency := Index;
2605 when '_' | '0' | '/' => Skip;
2608 Pic.Picture.Expanded (Index) := 'b';
2611 when others => return;
2614 end Trailing_Currency;
2616 ----------------------
2617 -- Zero_Suppression --
2618 ----------------------
2620 procedure Zero_Suppression is
2623 Pic.Start_Float := Index;
2624 Pic.End_Float := Index;
2625 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2626 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2631 -- Even a single Z is a valid picture
2639 when '_' | '0' | '/' =>
2640 Pic.End_Float := Index;
2644 Pic.End_Float := Index;
2645 Pic.Picture.Expanded (Index) := 'b';
2649 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2651 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2652 Pic.End_Float := Index;
2661 when '.' | 'V' | 'v' =>
2662 Pic.Radix_Position := Index;
2664 Number_Fraction_Or_Z_Fill;
2676 end Zero_Suppression;
2678 -- Start of processing for Precalculate
2683 if State = Reject then
2684 raise Picture_Error;
2689 when Constraint_Error =>
2691 -- To deal with special cases like null strings
2693 raise Picture_Error;
2702 (Pic_String : String;
2703 Blank_When_Zero : Boolean := False) return Picture
2709 Item : constant String := Expand (Pic_String);
2712 Result.Contents.Picture := (Item'Length, Item);
2713 Result.Contents.Original_BWZ := Blank_When_Zero;
2714 Result.Contents.Blank_When_Zero := Blank_When_Zero;
2715 Precalculate (Result.Contents);
2721 raise Picture_Error;
2729 function To_Wide (C : Character) return Wide_Wide_Character is
2731 return Wide_Wide_Character'Val (Character'Pos (C));
2739 (Pic_String : String;
2740 Blank_When_Zero : Boolean := False) return Boolean
2744 Expanded_Pic : constant String := Expand (Pic_String);
2745 -- Raises Picture_Error if Item not well-formed
2747 Format_Rec : Format_Record;
2750 Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2751 Format_Rec.Blank_When_Zero := Blank_When_Zero;
2752 Format_Rec.Original_BWZ := Blank_When_Zero;
2753 Precalculate (Format_Rec);
2755 -- False only if Blank_When_0 is True but the pic string has a '*'
2757 return not Blank_When_Zero
2758 or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2762 when others => return False;
2765 end Ada.Wide_Wide_Text_IO.Editing;