1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- A D A . T E X T _ I O . E D I T I N G --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 with Ada.Strings.Fixed;
36 package body Ada.Text_IO.Editing is
38 package Strings renames Ada.Strings;
39 package Strings_Fixed renames Ada.Strings.Fixed;
40 package Text_IO renames Ada.Text_IO;
46 function Blank_When_Zero (Pic : in Picture) return Boolean is
48 return Pic.Contents.Original_BWZ;
55 function Expand (Picture : in String) return String is
56 Result : String (1 .. MAX_PICSIZE);
57 Picture_Index : Integer := Picture'First;
58 Result_Index : Integer := Result'First;
62 package Int_IO is new Ada.Text_IO.Integer_IO (Integer);
65 if Picture'Length < 1 then
69 if Picture (Picture'First) = '(' then
74 case Picture (Picture_Index) is
77 Int_IO.Get (Picture (Picture_Index + 1 .. Picture'Last),
80 if Picture (Last + 1) /= ')' then
84 -- In what follows note that one copy of the repeated
85 -- character has already been made, so a count of one is a
86 -- no-op, and a count of zero erases a character.
88 for J in 2 .. Count loop
89 Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
92 Result_Index := Result_Index + Count - 1;
94 -- Last + 1 was a ')' throw it away too.
96 Picture_Index := Last + 2;
102 Result (Result_Index) := Picture (Picture_Index);
103 Picture_Index := Picture_Index + 1;
104 Result_Index := Result_Index + 1;
108 exit when Picture_Index > Picture'Last;
111 return Result (1 .. Result_Index - 1);
123 function Format_Number
124 (Pic : Format_Record;
126 Currency_Symbol : String;
127 Fill_Character : Character;
128 Separator_Character : Character;
129 Radix_Point : Character)
132 Attrs : Number_Attributes := Parse_Number_String (Number);
134 Rounded : String := Number;
136 Sign_Position : Integer := Pic.Sign_Position; -- may float.
138 Answer : String (1 .. Pic.Picture.Length) := Pic.Picture.Expanded;
140 Currency_Pos : Integer := Pic.Start_Currency;
142 Dollar : Boolean := False;
143 -- Overridden immediately if necessary.
145 Zero : Boolean := True;
146 -- Set to False when a non-zero digit is output.
150 -- If the picture has fewer decimal places than the number, the image
151 -- must be rounded according to the usual rules.
153 if Attrs.Has_Fraction then
155 R : constant Integer :=
156 (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
157 - Pic.Max_Trailing_Digits;
162 R_Pos := Attrs.End_Of_Fraction - R;
164 if Rounded (R_Pos + 1) > '4' then
166 if Rounded (R_Pos) = '.' then
170 if Rounded (R_Pos) /= '9' then
171 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
173 Rounded (R_Pos) := '0';
177 if Rounded (R_Pos) = '.' then
181 if Rounded (R_Pos) /= '9' then
182 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
185 Rounded (R_Pos) := '0';
190 -- The rounding may add a digit in front. Either the
191 -- leading blank or the sign (already captured) can
195 Rounded (R_Pos) := '1';
196 Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
204 if Pic.Start_Currency /= Invalid_Position then
205 Dollar := Answer (Pic.Start_Currency) = '$';
208 -- Fix up "direct inserts" outside the playing field. Set up as one
209 -- loop to do the beginning, one (reverse) loop to do the end.
213 exit when Last = Pic.Start_Float;
214 exit when Last = Pic.Radix_Position;
215 exit when Answer (Last) = '9';
217 case Answer (Last) is
220 Answer (Last) := Separator_Character;
223 Answer (Last) := ' ';
230 exit when Last = Answer'Last;
235 -- Now for the end...
237 for J in reverse Last .. Answer'Last loop
238 exit when J = Pic.Radix_Position;
240 -- Do this test First, Separator_Character can equal Pic.Floater.
242 if Answer (J) = Pic.Floater then
249 Answer (J) := Separator_Character;
265 if Pic.Start_Currency /= -1
266 and then Answer (Pic.Start_Currency) = '#'
267 and then Pic.Floater /= '#'
269 if Currency_Symbol'Length >
270 Pic.End_Currency - Pic.Start_Currency + 1
274 elsif Currency_Symbol'Length =
275 Pic.End_Currency - Pic.Start_Currency + 1
277 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
280 elsif Pic.Radix_Position = Invalid_Position
281 or else Pic.Start_Currency < Pic.Radix_Position
283 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
285 Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
286 Pic.End_Currency) := Currency_Symbol;
289 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
291 Answer (Pic.Start_Currency ..
292 Pic.Start_Currency + Currency_Symbol'Length - 1) :=
297 -- Fill in leading digits
299 if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
300 Pic.Max_Leading_Digits
305 if Pic.Radix_Position = Invalid_Position then
306 Position := Answer'Last;
308 Position := Pic.Radix_Position - 1;
311 for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
313 while Answer (Position) /= '9'
314 and Answer (Position) /= Pic.Floater
316 if Answer (Position) = '_' then
317 Answer (Position) := Separator_Character;
319 elsif Answer (Position) = 'b' then
320 Answer (Position) := ' ';
323 Position := Position - 1;
326 Answer (Position) := Rounded (J);
328 if Rounded (J) /= '0' then
332 Position := Position - 1;
337 if Pic.Start_Float = Invalid_Position then
339 -- No leading floats, but need to change '9' to '0', '_' to
340 -- Separator_Character and 'b' to ' '.
342 for J in Last .. Position loop
344 -- Last set when fixing the "uninteresting" leaders above.
345 -- Don't duplicate the work.
347 if Answer (J) = '9' then
350 elsif Answer (J) = '_' then
351 Answer (J) := Separator_Character;
353 elsif Answer (J) = 'b' then
358 elsif Pic.Floater = '<'
364 for J in Pic.End_Float .. Position loop -- May be null range.
365 if Answer (J) = '9' then
368 elsif Answer (J) = '_' then
369 Answer (J) := Separator_Character;
371 elsif Answer (J) = 'b' then
376 if Position > Pic.End_Float then
377 Position := Pic.End_Float;
380 for J in Pic.Start_Float .. Position - 1 loop
384 Answer (Position) := Pic.Floater;
385 Sign_Position := Position;
387 elsif Pic.Floater = '$' then
389 for J in Pic.End_Float .. Position loop -- May be null range.
390 if Answer (J) = '9' then
393 elsif Answer (J) = '_' then
394 Answer (J) := ' '; -- no separators before leftmost digit.
396 elsif Answer (J) = 'b' then
401 if Position > Pic.End_Float then
402 Position := Pic.End_Float;
405 for J in Pic.Start_Float .. Position - 1 loop
409 Answer (Position) := Pic.Floater;
410 Currency_Pos := Position;
412 elsif Pic.Floater = '*' then
414 for J in Pic.End_Float .. Position loop -- May be null range.
415 if Answer (J) = '9' then
418 elsif Answer (J) = '_' then
419 Answer (J) := Separator_Character;
421 elsif Answer (J) = 'b' then
426 if Position > Pic.End_Float then
427 Position := Pic.End_Float;
430 for J in Pic.Start_Float .. Position loop
435 if Pic.Floater = '#' then
436 Currency_Pos := Currency_Symbol'Length;
439 for J in reverse Pic.Start_Float .. Position loop
443 Answer (J) := Fill_Character;
445 when 'Z' | 'b' | '/' | '0' =>
451 when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
455 if Currency_Pos = 0 then
458 Answer (J) := Currency_Symbol (Currency_Pos);
459 Currency_Pos := Currency_Pos - 1;
467 Answer (J) := Fill_Character;
473 if Currency_Pos = 0 then
477 Answer (J) := Currency_Symbol (Currency_Pos);
478 Currency_Pos := Currency_Pos - 1;
492 if Pic.Floater = '#' and then Currency_Pos /= 0 then
499 if Sign_Position = Invalid_Position then
500 if Attrs.Negative then
505 if Attrs.Negative then
506 case Answer (Sign_Position) is
507 when 'C' | 'D' | '-' =>
511 Answer (Sign_Position) := '-';
514 Answer (Sign_Position) := '(';
515 Answer (Pic.Second_Sign) := ')';
524 case Answer (Sign_Position) is
527 Answer (Sign_Position) := ' ';
529 when '<' | 'C' | 'D' =>
530 Answer (Sign_Position) := ' ';
531 Answer (Pic.Second_Sign) := ' ';
543 -- Fill in trailing digits
545 if Pic.Max_Trailing_Digits > 0 then
547 if Attrs.Has_Fraction then
548 Position := Attrs.Start_Of_Fraction;
549 Last := Pic.Radix_Position + 1;
551 for J in Last .. Answer'Last loop
553 if Answer (J) = '9' or Answer (J) = Pic.Floater then
554 Answer (J) := Rounded (Position);
556 if Rounded (Position) /= '0' then
560 Position := Position + 1;
563 -- Used up fraction but remember place in Answer
565 exit when Position > Attrs.End_Of_Fraction;
567 elsif Answer (J) = 'b' then
570 elsif Answer (J) = '_' then
571 Answer (J) := Separator_Character;
581 Position := Pic.Radix_Position + 1;
584 -- Now fill remaining 9's with zeros and _ with separators
588 for J in Position .. Last loop
589 if Answer (J) = '9' then
592 elsif Answer (J) = Pic.Floater then
595 elsif Answer (J) = '_' then
596 Answer (J) := Separator_Character;
598 elsif Answer (J) = 'b' then
604 Position := Last + 1;
607 if Pic.Floater = '#' and then Currency_Pos /= 0 then
611 -- No trailing digits, but now J may need to stick in a currency
614 if Pic.Start_Currency = Invalid_Position then
615 Position := Answer'Last + 1;
617 Position := Pic.Start_Currency;
621 for J in Position .. Answer'Last loop
623 if Pic.Start_Currency /= Invalid_Position and then
624 Answer (Pic.Start_Currency) = '#' then
628 -- Note: There are some weird cases J can imagine with 'b' or '#'
629 -- in currency strings where the following code will cause
630 -- glitches. The trick is to tell when the character in the
631 -- answer should be checked, and when to look at the original
632 -- string. Some other time. RIE 11/26/96 ???
636 Answer (J) := Fill_Character;
642 if Currency_Pos > Currency_Symbol'Length then
646 Answer (J) := Currency_Symbol (Currency_Pos);
647 Currency_Pos := Currency_Pos + 1;
655 Answer (J) := Fill_Character;
661 if Currency_Pos > Currency_Symbol'Length then
664 Answer (J) := Currency_Symbol (Currency_Pos);
665 Currency_Pos := Currency_Pos + 1;
679 -- Now get rid of Blank_when_Zero and complete Star fill.
681 if Zero and Pic.Blank_When_Zero then
683 -- Value is zero, and blank it.
688 Last := Last - 1 + Currency_Symbol'Length;
691 if Pic.Radix_Position /= Invalid_Position and then
692 Answer (Pic.Radix_Position) = 'V' then
696 return String' (1 .. Last => ' ');
698 elsif Zero and Pic.Star_Fill then
702 Last := Last - 1 + Currency_Symbol'Length;
705 if Pic.Radix_Position /= Invalid_Position then
707 if Answer (Pic.Radix_Position) = 'V' then
711 if Pic.Radix_Position > Pic.Start_Currency then
712 return String' (1 .. Pic.Radix_Position - 1 => '*') &
714 String' (Pic.Radix_Position + 1 .. Last => '*');
720 Pic.Radix_Position + Currency_Symbol'Length - 2 =>
723 (Pic.Radix_Position + Currency_Symbol'Length .. Last
728 return String' (1 .. Pic.Radix_Position - 1 => '*') &
730 String' (Pic.Radix_Position + 1 .. Last => '*');
734 return String' (1 .. Last => '*');
737 -- This was once a simple return statement, now there are nine
738 -- different return cases. Not to mention the five above to deal
739 -- with zeros. Why not split things out?
741 -- Processing the radix and sign expansion separately
742 -- would require lots of copying--the string and some of its
743 -- indices--without really simplifying the logic. The cases are:
745 -- 1) Expand $, replace '.' with Radix_Point
746 -- 2) No currency expansion, replace '.' with Radix_Point
747 -- 3) Expand $, radix blanked
748 -- 4) No currency expansion, radix blanked
750 -- 6) Expand $, Elide V
751 -- 7) Elide V, Expand $ (Two cases depending on order.)
752 -- 8) No radix, expand $
753 -- 9) No radix, no currency expansion
755 if Pic.Radix_Position /= Invalid_Position then
757 if Answer (Pic.Radix_Position) = '.' then
758 Answer (Pic.Radix_Position) := Radix_Point;
762 -- 1) Expand $, replace '.' with Radix_Point
764 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
765 Answer (Currency_Pos + 1 .. Answer'Last);
768 -- 2) No currency expansion, replace '.' with Radix_Point
773 elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix.
776 -- 3) Expand $, radix blanked
778 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
779 Answer (Currency_Pos + 1 .. Answer'Last);
782 -- 4) No expansion, radix blanked
794 return Answer (1 .. Pic.Radix_Position - 1) &
795 Answer (Pic.Radix_Position + 1 .. Answer'Last);
797 elsif Currency_Pos < Pic.Radix_Position then
799 -- 6) Expand $, Elide V
801 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
802 Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
803 Answer (Pic.Radix_Position + 1 .. Answer'Last);
806 -- 7) Elide V, Expand $
808 return Answer (1 .. Pic.Radix_Position - 1) &
809 Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
811 Answer (Currency_Pos + 1 .. Answer'Last);
817 -- 8) No radix, expand $
819 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
820 Answer (Currency_Pos + 1 .. Answer'Last);
823 -- 9) No radix, no currency expansion
830 -------------------------
831 -- Parse_Number_String --
832 -------------------------
834 function Parse_Number_String (Str : String) return Number_Attributes is
835 Answer : Number_Attributes;
838 for J in Str'Range loop
846 -- Decide if this is the start of a number.
847 -- If so, figure out which one...
849 if Answer.Has_Fraction then
850 Answer.End_Of_Fraction := J;
852 if Answer.Start_Of_Int = Invalid_Position then
854 Answer.Start_Of_Int := J;
856 Answer.End_Of_Int := J;
861 -- Only count a zero before the decimal point if it follows a
862 -- non-zero digit. After the decimal point, zeros will be
863 -- counted if followed by a non-zero digit.
865 if not Answer.Has_Fraction then
866 if Answer.Start_Of_Int /= Invalid_Position then
867 Answer.End_Of_Int := J;
875 Answer.Negative := True;
879 -- Close integer, start fraction
881 if Answer.Has_Fraction then
885 -- Two decimal points is a no-no.
887 Answer.Has_Fraction := True;
888 Answer.End_Of_Fraction := J;
890 -- Could leave this at Invalid_Position, but this seems the
891 -- right way to indicate a null range...
893 Answer.Start_Of_Fraction := J + 1;
894 Answer.End_Of_Int := J - 1;
897 raise Picture_Error; -- can this happen? probably not!
901 if Answer.Start_Of_Int = Invalid_Position then
902 Answer.Start_Of_Int := Answer.End_Of_Int + 1;
905 -- No significant (intger) digits needs a null range.
909 end Parse_Number_String;
915 -- The following ensures that we return B and not b being careful not
916 -- to break things which expect lower case b for blank. See CXF3A02.
918 function Pic_String (Pic : in Picture) return String is
919 Temp : String (1 .. Pic.Contents.Picture.Length) :=
920 Pic.Contents.Picture.Expanded;
922 for J in Temp'Range loop
923 if Temp (J) = 'b' then Temp (J) := 'B'; end if;
933 procedure Precalculate (Pic : in out Format_Record) is
935 Computed_BWZ : Boolean := True;
936 Debug : Boolean := False;
938 type Legality is (Okay, Reject);
939 State : Legality := Reject;
940 -- Start in reject, which will reject null strings.
942 Index : Pic_Index := Pic.Picture.Expanded'First;
944 function At_End return Boolean;
945 pragma Inline (At_End);
947 procedure Set_State (L : Legality);
948 pragma Inline (Set_State);
950 function Look return Character;
951 pragma Inline (Look);
953 function Is_Insert return Boolean;
954 pragma Inline (Is_Insert);
957 pragma Inline (Skip);
959 procedure Debug_Start (Name : String);
960 pragma Inline (Debug_Start);
962 procedure Debug_Integer (Value : in Integer; S : String);
963 pragma Inline (Debug_Integer);
965 procedure Trailing_Currency;
966 procedure Trailing_Bracket;
967 procedure Number_Fraction;
968 procedure Number_Completion;
969 procedure Number_Fraction_Or_Bracket;
970 procedure Number_Fraction_Or_Z_Fill;
971 procedure Zero_Suppression;
972 procedure Floating_Bracket;
973 procedure Number_Fraction_Or_Star_Fill;
974 procedure Star_Suppression;
975 procedure Number_Fraction_Or_Dollar;
976 procedure Leading_Dollar;
977 procedure Number_Fraction_Or_Pound;
978 procedure Leading_Pound;
980 procedure Floating_Plus;
981 procedure Floating_Minus;
982 procedure Picture_Plus;
983 procedure Picture_Minus;
984 procedure Picture_Bracket;
986 procedure Optional_RHS_Sign;
987 procedure Picture_String;
993 function At_End return Boolean is
995 return Index > Pic.Picture.Length;
1002 procedure Debug_Integer (Value : in Integer; S : String) is
1003 use Ada.Text_IO; -- needed for >
1006 if Debug and then Value > 0 then
1007 if Ada.Text_IO.Col > 70 - S'Length then
1008 Ada.Text_IO.New_Line;
1011 Ada.Text_IO.Put (' ' & S & Integer'Image (Value) & ',');
1019 procedure Debug_Start (Name : String) is
1022 Ada.Text_IO.Put_Line (" In " & Name & '.');
1026 ----------------------
1027 -- Floating_Bracket --
1028 ----------------------
1030 -- Note that Floating_Bracket is only called with an acceptable
1031 -- prefix. But we don't set Okay, because we must end with a '>'.
1033 procedure Floating_Bracket is
1035 Debug_Start ("Floating_Bracket");
1037 Pic.End_Float := Index;
1038 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1040 -- First bracket wasn't counted...
1051 when '_' | '0' | '/' =>
1052 Pic.End_Float := Index;
1056 Pic.End_Float := Index;
1057 Pic.Picture.Expanded (Index) := 'b';
1061 Pic.End_Float := Index;
1062 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1074 when 'V' | 'v' | '.' =>
1075 Pic.Radix_Position := Index;
1077 Number_Fraction_Or_Bracket;
1084 end Floating_Bracket;
1087 --------------------
1088 -- Floating_Minus --
1089 --------------------
1091 procedure Floating_Minus is
1093 Debug_Start ("Floating_Minus");
1101 when '_' | '0' | '/' =>
1102 Pic.End_Float := Index;
1106 Pic.End_Float := Index;
1107 Pic.Picture.Expanded (Index) := 'b';
1111 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1112 Pic.End_Float := Index;
1119 when '.' | 'V' | 'v' =>
1120 Pic.Radix_Position := Index;
1123 while Is_Insert loop
1140 Pic.Max_Trailing_Digits :=
1141 Pic.Max_Trailing_Digits + 1;
1142 Pic.End_Float := Index;
1145 when '_' | '0' | '/' =>
1149 Pic.Picture.Expanded (Index) := 'b';
1174 procedure Floating_Plus is
1176 Debug_Start ("Floating_Plus");
1184 when '_' | '0' | '/' =>
1185 Pic.End_Float := Index;
1189 Pic.End_Float := Index;
1190 Pic.Picture.Expanded (Index) := 'b';
1194 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1195 Pic.End_Float := Index;
1202 when '.' | 'V' | 'v' =>
1203 Pic.Radix_Position := Index;
1206 while Is_Insert loop
1223 Pic.Max_Trailing_Digits :=
1224 Pic.Max_Trailing_Digits + 1;
1225 Pic.End_Float := Index;
1228 when '_' | '0' | '/' =>
1232 Pic.Picture.Expanded (Index) := 'b';
1258 function Is_Insert return Boolean is
1264 case Pic.Picture.Expanded (Index) is
1266 when '_' | '0' | '/' => return True;
1269 Pic.Picture.Expanded (Index) := 'b'; -- canonical
1272 when others => return False;
1276 --------------------
1277 -- Leading_Dollar --
1278 --------------------
1280 -- Note that Leading_Dollar can be called in either State.
1281 -- It will set state to Okay only if a 9 or (second) $
1284 -- Also notice the tricky bit with State and Zero_Suppression.
1285 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1286 -- encountered, exactly the cases where State has been set.
1288 procedure Leading_Dollar is
1290 Debug_Start ("Leading_Dollar");
1292 -- Treat as a floating dollar, and unwind otherwise.
1295 Pic.Start_Currency := Index;
1296 Pic.End_Currency := Index;
1297 Pic.Start_Float := Index;
1298 Pic.End_Float := Index;
1300 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1312 when '_' | '0' | '/' =>
1313 Pic.End_Float := Index;
1316 -- A trailing insertion character is not part of the
1317 -- floating currency, so need to look ahead.
1320 Pic.End_Float := Pic.End_Float - 1;
1324 Pic.End_Float := Index;
1325 Pic.Picture.Expanded (Index) := 'b';
1329 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1331 if State = Okay then
1332 raise Picture_Error;
1334 -- Will overwrite Floater and Start_Float
1340 if State = Okay then
1341 raise Picture_Error;
1343 -- Will overwrite Floater and Start_Float
1349 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1350 Pic.End_Float := Index;
1351 Pic.End_Currency := Index;
1352 Set_State (Okay); Skip;
1355 if State /= Okay then
1357 Pic.Start_Float := Invalid_Position;
1358 Pic.End_Float := Invalid_Position;
1361 -- A single dollar does not a floating make.
1366 when 'V' | 'v' | '.' =>
1367 if State /= Okay then
1369 Pic.Start_Float := Invalid_Position;
1370 Pic.End_Float := Invalid_Position;
1373 -- Only one dollar before the sign is okay,
1374 -- but doesn't float.
1376 Pic.Radix_Position := Index;
1378 Number_Fraction_Or_Dollar;
1392 -- This one is complex! A Leading_Pound can be fixed or floating,
1393 -- but in some cases the decision has to be deferred until we leave
1394 -- this procedure. Also note that Leading_Pound can be called in
1397 -- It will set state to Okay only if a 9 or (second) # is
1400 -- One Last note: In ambiguous cases, the currency is treated as
1401 -- floating unless there is only one '#'.
1403 procedure Leading_Pound is
1405 Inserts : Boolean := False;
1406 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1408 Must_Float : Boolean := False;
1409 -- Set to true if a '#' occurs after an insert.
1412 Debug_Start ("Leading_Pound");
1414 -- Treat as a floating currency. If it isn't, this will be
1415 -- overwritten later.
1419 Pic.Start_Currency := Index;
1420 Pic.End_Currency := Index;
1421 Pic.Start_Float := Index;
1422 Pic.End_Float := Index;
1424 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1427 Pic.Max_Currency_Digits := 1; -- we've seen one.
1438 when '_' | '0' | '/' =>
1439 Pic.End_Float := Index;
1444 Pic.Picture.Expanded (Index) := 'b';
1445 Pic.End_Float := Index;
1450 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1453 raise Picture_Error;
1455 Pic.Max_Leading_Digits := 0;
1457 -- Will overwrite Floater and Start_Float
1464 raise Picture_Error;
1466 Pic.Max_Leading_Digits := 0;
1468 -- Will overwrite Floater and Start_Float
1478 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1479 Pic.End_Float := Index;
1480 Pic.End_Currency := Index;
1485 if State /= Okay then
1487 -- A single '#' doesn't float.
1490 Pic.Start_Float := Invalid_Position;
1491 Pic.End_Float := Invalid_Position;
1497 when 'V' | 'v' | '.' =>
1498 if State /= Okay then
1500 Pic.Start_Float := Invalid_Position;
1501 Pic.End_Float := Invalid_Position;
1504 -- Only one pound before the sign is okay,
1505 -- but doesn't float.
1507 Pic.Radix_Position := Index;
1509 Number_Fraction_Or_Pound;
1522 function Look return Character is
1525 raise Picture_Error;
1528 return Pic.Picture.Expanded (Index);
1537 Debug_Start ("Number");
1542 when '_' | '0' | '/' =>
1546 Pic.Picture.Expanded (Index) := 'b';
1550 Computed_BWZ := False;
1551 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1555 when '.' | 'V' | 'v' =>
1556 Pic.Radix_Position := Index;
1570 -- Will return in Okay state if a '9' was seen.
1575 -----------------------
1576 -- Number_Completion --
1577 -----------------------
1579 procedure Number_Completion is
1581 Debug_Start ("Number_Completion");
1583 while not At_End loop
1586 when '_' | '0' | '/' =>
1590 Pic.Picture.Expanded (Index) := 'b';
1594 Computed_BWZ := False;
1595 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1599 when 'V' | 'v' | '.' =>
1600 Pic.Radix_Position := Index;
1609 end Number_Completion;
1611 ---------------------
1612 -- Number_Fraction --
1613 ---------------------
1615 procedure Number_Fraction is
1617 -- Note that number fraction can be called in either State.
1618 -- It will set state to Valid only if a 9 is encountered.
1620 Debug_Start ("Number_Fraction");
1628 when '_' | '0' | '/' =>
1632 Pic.Picture.Expanded (Index) := 'b';
1636 Computed_BWZ := False;
1637 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1638 Set_State (Okay); Skip;
1644 end Number_Fraction;
1646 --------------------------------
1647 -- Number_Fraction_Or_Bracket --
1648 --------------------------------
1650 procedure Number_Fraction_Or_Bracket is
1652 Debug_Start ("Number_Fraction_Or_Bracket");
1661 when '_' | '0' | '/' => Skip;
1664 Pic.Picture.Expanded (Index) := 'b';
1668 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1669 Pic.End_Float := Index;
1678 when '_' | '0' | '/' =>
1682 Pic.Picture.Expanded (Index) := 'b';
1686 Pic.Max_Trailing_Digits :=
1687 Pic.Max_Trailing_Digits + 1;
1688 Pic.End_Float := Index;
1701 end Number_Fraction_Or_Bracket;
1703 -------------------------------
1704 -- Number_Fraction_Or_Dollar --
1705 -------------------------------
1707 procedure Number_Fraction_Or_Dollar is
1709 Debug_Start ("Number_Fraction_Or_Dollar");
1717 when '_' | '0' | '/' =>
1721 Pic.Picture.Expanded (Index) := 'b';
1725 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1726 Pic.End_Float := Index;
1735 when '_' | '0' | '/' =>
1739 Pic.Picture.Expanded (Index) := 'b';
1743 Pic.Max_Trailing_Digits :=
1744 Pic.Max_Trailing_Digits + 1;
1745 Pic.End_Float := Index;
1758 end Number_Fraction_Or_Dollar;
1760 ------------------------------
1761 -- Number_Fraction_Or_Pound --
1762 ------------------------------
1764 procedure Number_Fraction_Or_Pound is
1773 when '_' | '0' | '/' =>
1777 Pic.Picture.Expanded (Index) := 'b';
1781 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1782 Pic.End_Float := Index;
1792 when '_' | '0' | '/' =>
1796 Pic.Picture.Expanded (Index) := 'b';
1800 Pic.Max_Trailing_Digits :=
1801 Pic.Max_Trailing_Digits + 1;
1802 Pic.End_Float := Index;
1817 end Number_Fraction_Or_Pound;
1819 ----------------------------------
1820 -- Number_Fraction_Or_Star_Fill --
1821 ----------------------------------
1823 procedure Number_Fraction_Or_Star_Fill is
1825 Debug_Start ("Number_Fraction_Or_Star_Fill");
1834 when '_' | '0' | '/' =>
1838 Pic.Picture.Expanded (Index) := 'b';
1842 Pic.Star_Fill := True;
1843 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1844 Pic.End_Float := Index;
1854 when '_' | '0' | '/' =>
1858 Pic.Picture.Expanded (Index) := 'b';
1862 Pic.Star_Fill := True;
1863 Pic.Max_Trailing_Digits :=
1864 Pic.Max_Trailing_Digits + 1;
1865 Pic.End_Float := Index;
1879 end Number_Fraction_Or_Star_Fill;
1881 -------------------------------
1882 -- Number_Fraction_Or_Z_Fill --
1883 -------------------------------
1885 procedure Number_Fraction_Or_Z_Fill is
1887 Debug_Start ("Number_Fraction_Or_Z_Fill");
1896 when '_' | '0' | '/' =>
1900 Pic.Picture.Expanded (Index) := 'b';
1904 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1905 Pic.End_Float := Index;
1906 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1917 when '_' | '0' | '/' =>
1921 Pic.Picture.Expanded (Index) := 'b';
1925 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1927 Pic.Max_Trailing_Digits :=
1928 Pic.Max_Trailing_Digits + 1;
1929 Pic.End_Float := Index;
1942 end Number_Fraction_Or_Z_Fill;
1944 -----------------------
1945 -- Optional_RHS_Sign --
1946 -----------------------
1948 procedure Optional_RHS_Sign is
1950 Debug_Start ("Optional_RHS_Sign");
1959 Pic.Sign_Position := Index;
1964 Pic.Sign_Position := Index;
1965 Pic.Picture.Expanded (Index) := 'C';
1968 if Look = 'R' or Look = 'r' then
1969 Pic.Second_Sign := Index;
1970 Pic.Picture.Expanded (Index) := 'R';
1974 raise Picture_Error;
1980 Pic.Sign_Position := Index;
1981 Pic.Picture.Expanded (Index) := 'D';
1984 if Look = 'B' or Look = 'b' then
1985 Pic.Second_Sign := Index;
1986 Pic.Picture.Expanded (Index) := 'B';
1990 raise Picture_Error;
1996 if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
1997 Pic.Second_Sign := Index;
2001 raise Picture_Error;
2008 end Optional_RHS_Sign;
2014 -- Note that Picture can be called in either State.
2016 -- It will set state to Valid only if a 9 is encountered or floating
2017 -- currency is called.
2019 procedure Picture is
2021 Debug_Start ("Picture");
2030 when '_' | '0' | '/' =>
2034 Pic.Picture.Expanded (Index) := 'b';
2046 Computed_BWZ := False;
2048 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2051 when 'V' | 'v' | '.' =>
2052 Pic.Radix_Position := Index;
2065 ---------------------
2066 -- Picture_Bracket --
2067 ---------------------
2069 procedure Picture_Bracket is
2071 Pic.Sign_Position := Index;
2072 Debug_Start ("Picture_Bracket");
2073 Pic.Sign_Position := Index;
2075 -- Treat as a floating sign, and unwind otherwise.
2078 Pic.Start_Float := Index;
2079 Pic.End_Float := Index;
2081 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2084 Skip; -- Known Bracket
2089 when '_' | '0' | '/' =>
2090 Pic.End_Float := Index;
2094 Pic.End_Float := Index;
2095 Pic.Picture.Expanded (Index) := 'b';
2099 Set_State (Okay); -- "<<>" is enough.
2105 when '$' | '#' | '9' | '*' =>
2106 if State /= Okay then
2108 Pic.Start_Float := Invalid_Position;
2109 Pic.End_Float := Invalid_Position;
2117 when '.' | 'V' | 'v' =>
2118 if State /= Okay then
2120 Pic.Start_Float := Invalid_Position;
2121 Pic.End_Float := Invalid_Position;
2124 -- Don't assume that state is okay, haven't seen a digit
2131 raise Picture_Error;
2135 end Picture_Bracket;
2141 procedure Picture_Minus is
2143 Debug_Start ("Picture_Minus");
2145 Pic.Sign_Position := Index;
2147 -- Treat as a floating sign, and unwind otherwise.
2150 Pic.Start_Float := Index;
2151 Pic.End_Float := Index;
2153 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2156 Skip; -- Known Minus
2161 when '_' | '0' | '/' =>
2162 Pic.End_Float := Index;
2166 Pic.End_Float := Index;
2167 Pic.Picture.Expanded (Index) := 'b';
2171 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2172 Pic.End_Float := Index;
2174 Set_State (Okay); -- "-- " is enough.
2179 when '$' | '#' | '9' | '*' =>
2180 if State /= Okay then
2182 Pic.Start_Float := Invalid_Position;
2183 Pic.End_Float := Invalid_Position;
2192 -- Can't have Z and a floating sign.
2194 if State = Okay then
2198 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2204 when '.' | 'V' | 'v' =>
2205 if State /= Okay then
2207 Pic.Start_Float := Invalid_Position;
2208 Pic.End_Float := Invalid_Position;
2211 -- Don't assume that state is okay, haven't seen a digit.
2227 procedure Picture_Plus is
2229 Debug_Start ("Picture_Plus");
2230 Pic.Sign_Position := Index;
2232 -- Treat as a floating sign, and unwind otherwise.
2235 Pic.Start_Float := Index;
2236 Pic.End_Float := Index;
2238 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2246 when '_' | '0' | '/' =>
2247 Pic.End_Float := Index;
2251 Pic.End_Float := Index;
2252 Pic.Picture.Expanded (Index) := 'b';
2256 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2257 Pic.End_Float := Index;
2259 Set_State (Okay); -- "++" is enough.
2264 when '$' | '#' | '9' | '*' =>
2265 if State /= Okay then
2267 Pic.Start_Float := Invalid_Position;
2268 Pic.End_Float := Invalid_Position;
2276 if State = Okay then
2280 -- Can't have Z and a floating sign.
2282 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2284 -- '+Z' is acceptable
2293 when '.' | 'V' | 'v' =>
2294 if State /= Okay then
2296 Pic.Start_Float := Invalid_Position;
2297 Pic.End_Float := Invalid_Position;
2300 -- Don't assume that state is okay, haven't seen a digit.
2312 --------------------
2313 -- Picture_String --
2314 --------------------
2316 procedure Picture_String is
2318 Debug_Start ("Picture_String");
2320 while Is_Insert loop
2340 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2350 when '9' | '.' | 'V' | 'v' =>
2356 raise Picture_Error;
2360 -- Blank when zero either if the PIC does not contain a '9' or if
2361 -- requested by the user and no '*'
2363 Pic.Blank_When_Zero :=
2364 (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
2366 -- Star fill if '*' and no '9'.
2368 Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
2380 procedure Set_State (L : Legality) is
2382 if Debug then Ada.Text_IO.Put_Line
2383 (" Set state from " & Legality'Image (State) &
2384 " to " & Legality'Image (L));
2396 if Debug then Ada.Text_IO.Put_Line
2397 (" Skip " & Pic.Picture.Expanded (Index));
2403 ----------------------
2404 -- Star_Suppression --
2405 ----------------------
2407 procedure Star_Suppression is
2409 Debug_Start ("Star_Suppression");
2411 Pic.Start_Float := Index;
2412 Pic.End_Float := Index;
2413 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2416 -- Even a single * is a valid picture
2418 Pic.Star_Fill := True;
2428 when '_' | '0' | '/' =>
2429 Pic.End_Float := Index;
2433 Pic.End_Float := Index;
2434 Pic.Picture.Expanded (Index) := 'b';
2438 Pic.End_Float := Index;
2439 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2440 Set_State (Okay); Skip;
2447 when '.' | 'V' | 'v' =>
2448 Pic.Radix_Position := Index;
2450 Number_Fraction_Or_Star_Fill;
2458 when others => raise Picture_Error;
2461 end Star_Suppression;
2463 ----------------------
2464 -- Trailing_Bracket --
2465 ----------------------
2467 procedure Trailing_Bracket is
2469 Debug_Start ("Trailing_Bracket");
2472 Pic.Second_Sign := Index;
2475 raise Picture_Error;
2477 end Trailing_Bracket;
2479 -----------------------
2480 -- Trailing_Currency --
2481 -----------------------
2483 procedure Trailing_Currency is
2485 Debug_Start ("Trailing_Currency");
2492 Pic.Start_Currency := Index;
2493 Pic.End_Currency := Index;
2497 while not At_End and then Look = '#' loop
2498 if Pic.Start_Currency = Invalid_Position then
2499 Pic.Start_Currency := Index;
2502 Pic.End_Currency := Index;
2513 when '_' | '0' | '/' => Skip;
2516 Pic.Picture.Expanded (Index) := 'b';
2519 when others => return;
2522 end Trailing_Currency;
2524 ----------------------
2525 -- Zero_Suppression --
2526 ----------------------
2528 procedure Zero_Suppression is
2530 Debug_Start ("Zero_Suppression");
2533 Pic.Start_Float := Index;
2534 Pic.End_Float := Index;
2535 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2536 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2541 -- Even a single Z is a valid picture
2549 when '_' | '0' | '/' =>
2550 Pic.End_Float := Index;
2554 Pic.End_Float := Index;
2555 Pic.Picture.Expanded (Index) := 'b';
2559 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2561 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2562 Pic.End_Float := Index;
2571 when '.' | 'V' | 'v' =>
2572 Pic.Radix_Position := Index;
2574 Number_Fraction_Or_Z_Fill;
2586 end Zero_Suppression;
2588 -- Start of processing for Precalculate
2594 Ada.Text_IO.New_Line;
2595 Ada.Text_IO.Put (" Picture : """ &
2596 Pic.Picture.Expanded (1 .. Pic.Picture.Length) & """,");
2597 Ada.Text_IO.Put (" Floater : '" & Pic.Floater & "',");
2600 if State = Reject then
2601 raise Picture_Error;
2604 Debug_Integer (Pic.Radix_Position, "Radix Positon : ");
2605 Debug_Integer (Pic.Sign_Position, "Sign Positon : ");
2606 Debug_Integer (Pic.Second_Sign, "Second Sign : ");
2607 Debug_Integer (Pic.Start_Float, "Start Float : ");
2608 Debug_Integer (Pic.End_Float, "End Float : ");
2609 Debug_Integer (Pic.Start_Currency, "Start Currency : ");
2610 Debug_Integer (Pic.End_Currency, "End Currency : ");
2611 Debug_Integer (Pic.Max_Leading_Digits, "Max Leading Digits : ");
2612 Debug_Integer (Pic.Max_Trailing_Digits, "Max Trailing Digits : ");
2615 Ada.Text_IO.New_Line;
2620 when Constraint_Error =>
2622 -- To deal with special cases like null strings.
2624 raise Picture_Error;
2633 (Pic_String : in String;
2634 Blank_When_Zero : in Boolean := False)
2641 Item : constant String := Expand (Pic_String);
2644 Result.Contents.Picture := (Item'Length, Item);
2645 Result.Contents.Original_BWZ := Blank_When_Zero;
2646 Result.Contents.Blank_When_Zero := Blank_When_Zero;
2647 Precalculate (Result.Contents);
2653 raise Picture_Error;
2662 (Pic_String : in String;
2663 Blank_When_Zero : in Boolean := False)
2668 Expanded_Pic : constant String := Expand (Pic_String);
2669 -- Raises Picture_Error if Item not well-formed
2671 Format_Rec : Format_Record;
2674 Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2675 Format_Rec.Blank_When_Zero := Blank_When_Zero;
2676 Format_Rec.Original_BWZ := Blank_When_Zero;
2677 Precalculate (Format_Rec);
2679 -- False only if Blank_When_0 is True but the pic string has a '*'
2681 return not Blank_When_Zero or
2682 Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2686 when others => return False;
2690 --------------------
2691 -- Decimal_Output --
2692 --------------------
2694 package body Decimal_Output is
2703 Currency : in String := Default_Currency;
2704 Fill : in Character := Default_Fill;
2705 Separator : in Character := Default_Separator;
2706 Radix_Mark : in Character := Default_Radix_Mark)
2710 return Format_Number
2711 (Pic.Contents, Num'Image (Item),
2712 Currency, Fill, Separator, Radix_Mark);
2721 Currency : in String := Default_Currency)
2724 Picstr : constant String := Pic_String (Pic);
2725 V_Adjust : Integer := 0;
2726 Cur_Adjust : Integer := 0;
2729 -- Check if Picstr has 'V' or '$'
2731 -- If 'V', then length is 1 less than otherwise
2733 -- If '$', then length is Currency'Length-1 more than otherwise
2735 -- This should use the string handling package ???
2737 for J in Picstr'Range loop
2738 if Picstr (J) = 'V' then
2741 elsif Picstr (J) = '$' then
2742 Cur_Adjust := Currency'Length - 1;
2746 return Picstr'Length - V_Adjust + Cur_Adjust;
2754 (File : in Text_IO.File_Type;
2757 Currency : in String := Default_Currency;
2758 Fill : in Character := Default_Fill;
2759 Separator : in Character := Default_Separator;
2760 Radix_Mark : in Character := Default_Radix_Mark)
2763 Text_IO.Put (File, Image (Item, Pic,
2764 Currency, Fill, Separator, Radix_Mark));
2770 Currency : in String := Default_Currency;
2771 Fill : in Character := Default_Fill;
2772 Separator : in Character := Default_Separator;
2773 Radix_Mark : in Character := Default_Radix_Mark)
2776 Text_IO.Put (Image (Item, Pic,
2777 Currency, Fill, Separator, Radix_Mark));
2784 Currency : in String := Default_Currency;
2785 Fill : in Character := Default_Fill;
2786 Separator : in Character := Default_Separator;
2787 Radix_Mark : in Character := Default_Radix_Mark)
2789 Result : constant String :=
2790 Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
2793 if Result'Length > To'Length then
2794 raise Text_IO.Layout_Error;
2796 Strings_Fixed.Move (Source => Result, Target => To,
2797 Justify => Strings.Right);
2808 Currency : in String := Default_Currency)
2813 Temp : constant String := Image (Item, Pic, Currency);
2814 pragma Warnings (Off, Temp);
2820 when Layout_Error => return False;
2826 end Ada.Text_IO.Editing;