1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . 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 package body Ada.Text_IO.Editing is
35 package Strings renames Ada.Strings;
36 package Strings_Fixed renames Ada.Strings.Fixed;
37 package Text_IO renames Ada.Text_IO;
43 function Blank_When_Zero (Pic : Picture) return Boolean is
45 return Pic.Contents.Original_BWZ;
52 function Expand (Picture : String) return String is
53 Result : String (1 .. MAX_PICSIZE);
54 Picture_Index : Integer := Picture'First;
55 Result_Index : Integer := Result'First;
59 package Int_IO is new Ada.Text_IO.Integer_IO (Integer);
62 if Picture'Length < 1 then
66 if Picture (Picture'First) = '(' then
71 case Picture (Picture_Index) is
75 (Picture (Picture_Index + 1 .. Picture'Last), Count, Last);
77 if Picture (Last + 1) /= ')' then
81 -- In what follows note that one copy of the repeated character
82 -- has already been made, so a count of one is a no-op, and a
83 -- count of zero erases a character.
85 if Result_Index + Count - 2 > Result'Last then
89 for J in 2 .. Count loop
90 Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
93 Result_Index := Result_Index + Count - 1;
95 -- Last + 1 was a ')' throw it away too
97 Picture_Index := Last + 2;
103 if Result_Index > Result'Last then
107 Result (Result_Index) := Picture (Picture_Index);
108 Picture_Index := Picture_Index + 1;
109 Result_Index := Result_Index + 1;
113 exit when Picture_Index > Picture'Last;
116 return Result (1 .. Result_Index - 1);
127 function Format_Number
128 (Pic : Format_Record;
130 Currency_Symbol : String;
131 Fill_Character : Character;
132 Separator_Character : Character;
133 Radix_Point : Character) return String
135 Attrs : Number_Attributes := Parse_Number_String (Number);
137 Rounded : String := Number;
139 Sign_Position : Integer := Pic.Sign_Position; -- may float.
141 Answer : String (1 .. Pic.Picture.Length) := Pic.Picture.Expanded;
143 Currency_Pos : Integer := Pic.Start_Currency;
144 In_Currency : Boolean := False;
146 Dollar : Boolean := False;
147 -- Overridden immediately if necessary
149 Zero : Boolean := True;
150 -- Set to False when a non-zero digit is output
154 -- If the picture has fewer decimal places than the number, the image
155 -- must be rounded according to the usual rules.
157 if Attrs.Has_Fraction then
159 R : constant Integer :=
160 (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
161 - Pic.Max_Trailing_Digits;
166 R_Pos := Attrs.End_Of_Fraction - R;
168 if Rounded (R_Pos + 1) > '4' then
170 if Rounded (R_Pos) = '.' then
174 if Rounded (R_Pos) /= '9' then
175 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
177 Rounded (R_Pos) := '0';
181 if Rounded (R_Pos) = '.' then
185 if Rounded (R_Pos) /= '9' then
186 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
189 Rounded (R_Pos) := '0';
194 -- The rounding may add a digit in front. Either the
195 -- leading blank or the sign (already captured) can
199 Rounded (R_Pos) := '1';
200 Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
208 if Pic.Start_Currency /= Invalid_Position then
209 Dollar := Answer (Pic.Start_Currency) = '$';
212 -- Fix up "direct inserts" outside the playing field. Set up as one
213 -- loop to do the beginning, one (reverse) loop to do the end.
217 exit when Last = Pic.Start_Float;
218 exit when Last = Pic.Radix_Position;
219 exit when Answer (Last) = '9';
221 case Answer (Last) is
224 Answer (Last) := Separator_Character;
227 Answer (Last) := ' ';
234 exit when Last = Answer'Last;
239 -- Now for the end...
241 for J in reverse Last .. Answer'Last loop
242 exit when J = Pic.Radix_Position;
244 -- Do this test First, Separator_Character can equal Pic.Floater
246 if Answer (J) = Pic.Floater then
253 Answer (J) := Separator_Character;
269 if Pic.Start_Currency /= -1
270 and then Answer (Pic.Start_Currency) = '#'
271 and then Pic.Floater /= '#'
273 if Currency_Symbol'Length >
274 Pic.End_Currency - Pic.Start_Currency + 1
278 elsif Currency_Symbol'Length =
279 Pic.End_Currency - Pic.Start_Currency + 1
281 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
284 elsif Pic.Radix_Position = Invalid_Position
285 or else Pic.Start_Currency < Pic.Radix_Position
287 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
289 Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
290 Pic.End_Currency) := Currency_Symbol;
293 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
295 Answer (Pic.Start_Currency ..
296 Pic.Start_Currency + Currency_Symbol'Length - 1) :=
301 -- Fill in leading digits
303 if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
304 Pic.Max_Leading_Digits
306 raise Ada.Text_IO.Layout_Error;
310 (if Pic.Radix_Position = Invalid_Position
312 else Pic.Radix_Position - 1);
314 for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
315 while Answer (Position) /= '9'
317 Answer (Position) /= Pic.Floater
319 if Answer (Position) = '_' then
320 Answer (Position) := Separator_Character;
322 elsif Answer (Position) = 'b' then
323 Answer (Position) := ' ';
326 Position := Position - 1;
329 Answer (Position) := Rounded (J);
331 if Rounded (J) /= '0' then
335 Position := Position - 1;
340 if Pic.Start_Float = Invalid_Position then
342 -- No leading floats, but need to change '9' to '0', '_' to
343 -- Separator_Character and 'b' to ' '.
345 for J in Last .. Position loop
347 -- Last set when fixing the "uninteresting" leaders above.
348 -- Don't duplicate the work.
350 if Answer (J) = '9' then
353 elsif Answer (J) = '_' then
354 Answer (J) := Separator_Character;
356 elsif Answer (J) = 'b' then
361 elsif Pic.Floater = '<'
367 for J in Pic.End_Float .. Position loop -- May be null range.
368 if Answer (J) = '9' then
371 elsif Answer (J) = '_' then
372 Answer (J) := Separator_Character;
374 elsif Answer (J) = 'b' then
379 if Position > Pic.End_Float then
380 Position := Pic.End_Float;
383 for J in Pic.Start_Float .. Position - 1 loop
387 Answer (Position) := Pic.Floater;
388 Sign_Position := Position;
390 elsif Pic.Floater = '$' then
392 for J in Pic.End_Float .. Position loop -- May be null range.
393 if Answer (J) = '9' then
396 elsif Answer (J) = '_' then
397 Answer (J) := ' '; -- no separators before leftmost digit.
399 elsif Answer (J) = 'b' then
404 if Position > Pic.End_Float then
405 Position := Pic.End_Float;
408 for J in Pic.Start_Float .. Position - 1 loop
412 Answer (Position) := Pic.Floater;
413 Currency_Pos := Position;
415 elsif Pic.Floater = '*' then
417 for J in Pic.End_Float .. Position loop -- May be null range.
418 if Answer (J) = '9' then
421 elsif Answer (J) = '_' then
422 Answer (J) := Separator_Character;
424 elsif Answer (J) = 'b' then
425 Answer (J) := Fill_Character;
429 if Position > Pic.End_Float then
430 Position := Pic.End_Float;
433 for J in Pic.Start_Float .. Position loop
434 Answer (J) := Fill_Character;
438 if Pic.Floater = '#' then
439 Currency_Pos := Currency_Symbol'Length;
443 for J in reverse Pic.Start_Float .. Position loop
447 Answer (J) := Fill_Character;
450 if In_Currency and then Currency_Pos > 0 then
451 Answer (J) := Currency_Symbol (Currency_Pos);
452 Currency_Pos := Currency_Pos - 1;
463 when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
467 if Currency_Pos = 0 then
470 Answer (J) := Currency_Symbol (Currency_Pos);
471 Currency_Pos := Currency_Pos - 1;
479 Answer (J) := Fill_Character;
485 if Currency_Pos = 0 then
489 Answer (J) := Currency_Symbol (Currency_Pos);
490 Currency_Pos := Currency_Pos - 1;
504 if Pic.Floater = '#' and then Currency_Pos /= 0 then
505 raise Ada.Text_IO.Layout_Error;
511 if Sign_Position = Invalid_Position then
512 if Attrs.Negative then
513 raise Ada.Text_IO.Layout_Error;
517 if Attrs.Negative then
518 case Answer (Sign_Position) is
519 when 'C' | 'D' | '-' =>
523 Answer (Sign_Position) := '-';
526 Answer (Sign_Position) := '(';
527 Answer (Pic.Second_Sign) := ')';
536 case Answer (Sign_Position) is
539 Answer (Sign_Position) := ' ';
541 when '<' | 'C' | 'D' =>
542 Answer (Sign_Position) := ' ';
543 Answer (Pic.Second_Sign) := ' ';
555 -- Fill in trailing digits
557 if Pic.Max_Trailing_Digits > 0 then
559 if Attrs.Has_Fraction then
560 Position := Attrs.Start_Of_Fraction;
561 Last := Pic.Radix_Position + 1;
563 for J in Last .. Answer'Last loop
564 if Answer (J) = '9' or else Answer (J) = Pic.Floater then
565 Answer (J) := Rounded (Position);
567 if Rounded (Position) /= '0' then
571 Position := Position + 1;
574 -- Used up fraction but remember place in Answer
576 exit when Position > Attrs.End_Of_Fraction;
578 elsif Answer (J) = 'b' then
581 elsif Answer (J) = '_' then
582 Answer (J) := Separator_Character;
592 Position := Pic.Radix_Position + 1;
595 -- Now fill remaining 9's with zeros and _ with separators
599 for J in Position .. Last loop
600 if Answer (J) = '9' then
603 elsif Answer (J) = Pic.Floater then
606 elsif Answer (J) = '_' then
607 Answer (J) := Separator_Character;
609 elsif Answer (J) = 'b' then
615 Position := Last + 1;
618 if Pic.Floater = '#' and then Currency_Pos /= 0 then
619 raise Ada.Text_IO.Layout_Error;
622 -- No trailing digits, but now J may need to stick in a currency
626 (if Pic.Start_Currency = Invalid_Position
628 else Pic.Start_Currency);
631 for J in Position .. Answer'Last loop
632 if Pic.Start_Currency /= Invalid_Position and then
633 Answer (Pic.Start_Currency) = '#' then
639 Answer (J) := Fill_Character;
643 Answer (J) := Currency_Symbol (Currency_Pos);
644 Currency_Pos := Currency_Pos + 1;
646 if Currency_Pos > Currency_Symbol'Length then
647 In_Currency := False;
652 if Currency_Pos > Currency_Symbol'Length then
657 Answer (J) := Currency_Symbol (Currency_Pos);
658 Currency_Pos := Currency_Pos + 1;
660 if Currency_Pos > Currency_Symbol'Length then
661 In_Currency := False;
666 Answer (J) := Currency_Symbol (Currency_Pos);
667 Currency_Pos := Currency_Pos + 1;
672 Answer (J) := Fill_Character;
678 if Currency_Pos > Currency_Symbol'Length then
681 Answer (J) := Currency_Symbol (Currency_Pos);
682 Currency_Pos := Currency_Pos + 1;
696 -- Now get rid of Blank_when_Zero and complete Star fill
698 if Zero and then Pic.Blank_When_Zero then
700 -- Value is zero, and blank it
705 Last := Last - 1 + Currency_Symbol'Length;
708 if Pic.Radix_Position /= Invalid_Position and then
709 Answer (Pic.Radix_Position) = 'V' then
713 return String'(1 .. Last => ' ');
715 elsif Zero and then Pic.Star_Fill then
719 Last := Last - 1 + Currency_Symbol'Length;
722 if Pic.Radix_Position /= Invalid_Position then
724 if Answer (Pic.Radix_Position) = 'V' then
728 if Pic.Radix_Position > Pic.Start_Currency then
729 return String'(1 .. Pic.Radix_Position - 1 => '*') &
731 String'(Pic.Radix_Position + 1 .. Last => '*');
737 Pic.Radix_Position + Currency_Symbol'Length - 2 =>
740 (Pic.Radix_Position + Currency_Symbol'Length .. Last
745 return String'(1 .. Pic.Radix_Position - 1 => '*') &
747 String'(Pic.Radix_Position + 1 .. Last => '*');
751 return String'(1 .. Last => '*');
754 -- This was once a simple return statement, now there are nine
755 -- different return cases. Not to mention the five above to deal
756 -- with zeros. Why not split things out?
758 -- Processing the radix and sign expansion separately
759 -- would require lots of copying--the string and some of its
760 -- indicies--without really simplifying the logic. The cases are:
762 -- 1) Expand $, replace '.' with Radix_Point
763 -- 2) No currency expansion, replace '.' with Radix_Point
764 -- 3) Expand $, radix blanked
765 -- 4) No currency expansion, radix blanked
767 -- 6) Expand $, Elide V
768 -- 7) Elide V, Expand $ (Two cases depending on order.)
769 -- 8) No radix, expand $
770 -- 9) No radix, no currency expansion
772 if Pic.Radix_Position /= Invalid_Position then
774 if Answer (Pic.Radix_Position) = '.' then
775 Answer (Pic.Radix_Position) := Radix_Point;
779 -- 1) Expand $, replace '.' with Radix_Point
781 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
782 Answer (Currency_Pos + 1 .. Answer'Last);
785 -- 2) No currency expansion, replace '.' with Radix_Point
790 elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix.
793 -- 3) Expand $, radix blanked
795 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
796 Answer (Currency_Pos + 1 .. Answer'Last);
799 -- 4) No expansion, radix blanked
811 return Answer (1 .. Pic.Radix_Position - 1) &
812 Answer (Pic.Radix_Position + 1 .. Answer'Last);
814 elsif Currency_Pos < Pic.Radix_Position then
816 -- 6) Expand $, Elide V
818 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
819 Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
820 Answer (Pic.Radix_Position + 1 .. Answer'Last);
823 -- 7) Elide V, Expand $
825 return Answer (1 .. Pic.Radix_Position - 1) &
826 Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
828 Answer (Currency_Pos + 1 .. Answer'Last);
834 -- 8) No radix, expand $
836 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
837 Answer (Currency_Pos + 1 .. Answer'Last);
840 -- 9) No radix, no currency expansion
846 -------------------------
847 -- Parse_Number_String --
848 -------------------------
850 function Parse_Number_String (Str : String) return Number_Attributes is
851 Answer : Number_Attributes;
854 for J in Str'Range loop
862 -- Decide if this is the start of a number.
863 -- If so, figure out which one...
865 if Answer.Has_Fraction then
866 Answer.End_Of_Fraction := J;
868 if Answer.Start_Of_Int = Invalid_Position then
870 Answer.Start_Of_Int := J;
872 Answer.End_Of_Int := J;
877 -- Only count a zero before the decimal point if it follows a
878 -- non-zero digit. After the decimal point, zeros will be
879 -- counted if followed by a non-zero digit.
881 if not Answer.Has_Fraction then
882 if Answer.Start_Of_Int /= Invalid_Position then
883 Answer.End_Of_Int := J;
891 Answer.Negative := True;
895 -- Close integer, start fraction
897 if Answer.Has_Fraction then
901 -- Two decimal points is a no-no
903 Answer.Has_Fraction := True;
904 Answer.End_Of_Fraction := J;
906 -- Could leave this at Invalid_Position, but this seems the
907 -- right way to indicate a null range...
909 Answer.Start_Of_Fraction := J + 1;
910 Answer.End_Of_Int := J - 1;
913 raise Picture_Error; -- can this happen? probably not!
917 if Answer.Start_Of_Int = Invalid_Position then
918 Answer.Start_Of_Int := Answer.End_Of_Int + 1;
921 -- No significant (integer) digits needs a null range
924 end Parse_Number_String;
930 -- The following ensures that we return B and not b being careful not
931 -- to break things which expect lower case b for blank. See CXF3A02.
933 function Pic_String (Pic : Picture) return String is
934 Temp : String (1 .. Pic.Contents.Picture.Length) :=
935 Pic.Contents.Picture.Expanded;
937 for J in Temp'Range loop
938 if Temp (J) = 'b' then
950 procedure Precalculate (Pic : in out Format_Record) is
951 Debug : constant Boolean := False;
952 -- Set True to generate debug output
954 Computed_BWZ : Boolean := True;
956 type Legality is (Okay, Reject);
958 State : Legality := Reject;
959 -- Start in reject, which will reject null strings
961 Index : Pic_Index := Pic.Picture.Expanded'First;
963 function At_End return Boolean;
964 pragma Inline (At_End);
966 procedure Set_State (L : Legality);
967 pragma Inline (Set_State);
969 function Look return Character;
970 pragma Inline (Look);
972 function Is_Insert return Boolean;
973 pragma Inline (Is_Insert);
976 pragma Inline (Skip);
978 procedure Debug_Start (Name : String);
979 pragma Inline (Debug_Start);
981 procedure Debug_Integer (Value : Integer; S : String);
982 pragma Inline (Debug_Integer);
984 procedure Trailing_Currency;
985 procedure Trailing_Bracket;
986 procedure Number_Fraction;
987 procedure Number_Completion;
988 procedure Number_Fraction_Or_Bracket;
989 procedure Number_Fraction_Or_Z_Fill;
990 procedure Zero_Suppression;
991 procedure Floating_Bracket;
992 procedure Number_Fraction_Or_Star_Fill;
993 procedure Star_Suppression;
994 procedure Number_Fraction_Or_Dollar;
995 procedure Leading_Dollar;
996 procedure Number_Fraction_Or_Pound;
997 procedure Leading_Pound;
999 procedure Floating_Plus;
1000 procedure Floating_Minus;
1001 procedure Picture_Plus;
1002 procedure Picture_Minus;
1003 procedure Picture_Bracket;
1005 procedure Optional_RHS_Sign;
1006 procedure Picture_String;
1007 procedure Set_Debug;
1013 function At_End return Boolean is
1015 Debug_Start ("At_End");
1016 return Index > Pic.Picture.Length;
1023 -- Needed to have a procedure to pass to pragma Debug
1025 procedure Set_Debug is
1027 -- Uncomment this line and make Debug a variable to enable debug
1038 procedure Debug_Integer (Value : Integer; S : String) is
1039 use Ada.Text_IO; -- needed for >
1042 if Debug and then Value > 0 then
1043 if Ada.Text_IO.Col > 70 - S'Length then
1044 Ada.Text_IO.New_Line;
1047 Ada.Text_IO.Put (' ' & S & Integer'Image (Value) & ',');
1055 procedure Debug_Start (Name : String) is
1058 Ada.Text_IO.Put_Line (" In " & Name & '.');
1062 ----------------------
1063 -- Floating_Bracket --
1064 ----------------------
1066 -- Note that Floating_Bracket is only called with an acceptable
1067 -- prefix. But we don't set Okay, because we must end with a '>'.
1069 procedure Floating_Bracket is
1071 Debug_Start ("Floating_Bracket");
1073 -- Two different floats not allowed
1075 if Pic.Floater /= '!' and then Pic.Floater /= '<' then
1076 raise Picture_Error;
1082 Pic.End_Float := Index;
1083 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1085 -- First bracket wasn't counted...
1096 when '_' | '0' | '/' =>
1097 Pic.End_Float := Index;
1101 Pic.End_Float := Index;
1102 Pic.Picture.Expanded (Index) := 'b';
1106 Pic.End_Float := Index;
1107 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1119 when 'V' | 'v' | '.' =>
1120 Pic.Radix_Position := Index;
1122 Number_Fraction_Or_Bracket;
1129 end Floating_Bracket;
1131 --------------------
1132 -- Floating_Minus --
1133 --------------------
1135 procedure Floating_Minus is
1137 Debug_Start ("Floating_Minus");
1145 when '_' | '0' | '/' =>
1146 Pic.End_Float := Index;
1150 Pic.End_Float := Index;
1151 Pic.Picture.Expanded (Index) := 'b';
1155 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1156 Pic.End_Float := Index;
1163 when '.' | 'V' | 'v' =>
1164 Pic.Radix_Position := Index;
1167 while Is_Insert loop
1184 Pic.Max_Trailing_Digits :=
1185 Pic.Max_Trailing_Digits + 1;
1186 Pic.End_Float := Index;
1189 when '_' | '0' | '/' =>
1193 Pic.Picture.Expanded (Index) := 'b';
1218 procedure Floating_Plus is
1220 Debug_Start ("Floating_Plus");
1228 when '_' | '0' | '/' =>
1229 Pic.End_Float := Index;
1233 Pic.End_Float := Index;
1234 Pic.Picture.Expanded (Index) := 'b';
1238 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1239 Pic.End_Float := Index;
1246 when '.' | 'V' | 'v' =>
1247 Pic.Radix_Position := Index;
1250 while Is_Insert loop
1267 Pic.Max_Trailing_Digits :=
1268 Pic.Max_Trailing_Digits + 1;
1269 Pic.End_Float := Index;
1272 when '_' | '0' | '/' =>
1276 Pic.Picture.Expanded (Index) := 'b';
1302 function Is_Insert return Boolean is
1308 case Pic.Picture.Expanded (Index) is
1310 when '_' | '0' | '/' => return True;
1313 Pic.Picture.Expanded (Index) := 'b'; -- canonical
1316 when others => return False;
1320 --------------------
1321 -- Leading_Dollar --
1322 --------------------
1324 -- Note that Leading_Dollar can be called in either State.
1325 -- It will set state to Okay only if a 9 or (second) $
1328 -- Also notice the tricky bit with State and Zero_Suppression.
1329 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1330 -- encountered, exactly the cases where State has been set.
1332 procedure Leading_Dollar is
1334 Debug_Start ("Leading_Dollar");
1336 -- Treat as a floating dollar, and unwind otherwise
1338 if Pic.Floater /= '!' and then Pic.Floater /= '$' then
1340 -- Two floats not allowed
1342 raise Picture_Error;
1348 Pic.Start_Currency := Index;
1349 Pic.End_Currency := Index;
1350 Pic.Start_Float := Index;
1351 Pic.End_Float := Index;
1353 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1365 when '_' | '0' | '/' =>
1366 Pic.End_Float := Index;
1369 -- A trailing insertion character is not part of the
1370 -- floating currency, so need to look ahead.
1373 Pic.End_Float := Pic.End_Float - 1;
1377 Pic.End_Float := Index;
1378 Pic.Picture.Expanded (Index) := 'b';
1382 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1384 if State = Okay then
1385 raise Picture_Error;
1387 -- Overwrite Floater and Start_Float
1390 Pic.Start_Float := Index;
1395 if State = Okay then
1396 raise Picture_Error;
1398 -- Overwrite Floater and Start_Float
1401 Pic.Start_Float := Index;
1406 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1407 Pic.End_Float := Index;
1408 Pic.End_Currency := Index;
1409 Set_State (Okay); Skip;
1412 if State /= Okay then
1414 Pic.Start_Float := Invalid_Position;
1415 Pic.End_Float := Invalid_Position;
1418 -- A single dollar does not a floating make
1423 when 'V' | 'v' | '.' =>
1424 if State /= Okay then
1426 Pic.Start_Float := Invalid_Position;
1427 Pic.End_Float := Invalid_Position;
1430 -- Only one dollar before the sign is okay, but doesn't
1433 Pic.Radix_Position := Index;
1435 Number_Fraction_Or_Dollar;
1449 -- This one is complex! A Leading_Pound can be fixed or floating,
1450 -- but in some cases the decision has to be deferred until we leave
1451 -- this procedure. Also note that Leading_Pound can be called in
1454 -- It will set state to Okay only if a 9 or (second) # is
1457 -- One Last note: In ambiguous cases, the currency is treated as
1458 -- floating unless there is only one '#'.
1460 procedure Leading_Pound is
1462 Inserts : Boolean := False;
1463 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1465 Must_Float : Boolean := False;
1466 -- Set to true if a '#' occurs after an insert
1469 Debug_Start ("Leading_Pound");
1471 -- Treat as a floating currency. If it isn't, this will be
1472 -- overwritten later.
1474 if Pic.Floater /= '!' and then Pic.Floater /= '#' then
1476 -- Two floats not allowed
1478 raise Picture_Error;
1484 Pic.Start_Currency := Index;
1485 Pic.End_Currency := Index;
1486 Pic.Start_Float := Index;
1487 Pic.End_Float := Index;
1489 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1492 Pic.Max_Currency_Digits := 1; -- we've seen one.
1503 when '_' | '0' | '/' =>
1504 Pic.End_Float := Index;
1509 Pic.Picture.Expanded (Index) := 'b';
1510 Pic.End_Float := Index;
1515 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1518 raise Picture_Error;
1520 Pic.Max_Leading_Digits := 0;
1522 -- Overwrite Floater and Start_Float
1525 Pic.Start_Float := Index;
1531 raise Picture_Error;
1533 Pic.Max_Leading_Digits := 0;
1535 -- Overwrite Floater and Start_Float
1537 Pic.Start_Float := Index;
1546 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1547 Pic.End_Float := Index;
1548 Pic.End_Currency := Index;
1553 if State /= Okay then
1555 -- A single '#' doesn't float
1558 Pic.Start_Float := Invalid_Position;
1559 Pic.End_Float := Invalid_Position;
1565 when 'V' | 'v' | '.' =>
1566 if State /= Okay then
1568 Pic.Start_Float := Invalid_Position;
1569 Pic.End_Float := Invalid_Position;
1572 -- Only one pound before the sign is okay, but doesn't
1575 Pic.Radix_Position := Index;
1577 Number_Fraction_Or_Pound;
1590 function Look return Character is
1593 raise Picture_Error;
1596 return Pic.Picture.Expanded (Index);
1605 Debug_Start ("Number");
1610 when '_' | '0' | '/' =>
1614 Pic.Picture.Expanded (Index) := 'b';
1618 Computed_BWZ := False;
1619 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1623 when '.' | 'V' | 'v' =>
1624 Pic.Radix_Position := Index;
1638 -- Will return in Okay state if a '9' was seen
1643 -----------------------
1644 -- Number_Completion --
1645 -----------------------
1647 procedure Number_Completion is
1649 Debug_Start ("Number_Completion");
1651 while not At_End loop
1654 when '_' | '0' | '/' =>
1658 Pic.Picture.Expanded (Index) := 'b';
1662 Computed_BWZ := False;
1663 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1667 when 'V' | 'v' | '.' =>
1668 Pic.Radix_Position := Index;
1677 end Number_Completion;
1679 ---------------------
1680 -- Number_Fraction --
1681 ---------------------
1683 procedure Number_Fraction is
1685 -- Note that number fraction can be called in either State.
1686 -- It will set state to Valid only if a 9 is encountered.
1688 Debug_Start ("Number_Fraction");
1696 when '_' | '0' | '/' =>
1700 Pic.Picture.Expanded (Index) := 'b';
1704 Computed_BWZ := False;
1705 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1706 Set_State (Okay); Skip;
1712 end Number_Fraction;
1714 --------------------------------
1715 -- Number_Fraction_Or_Bracket --
1716 --------------------------------
1718 procedure Number_Fraction_Or_Bracket is
1720 Debug_Start ("Number_Fraction_Or_Bracket");
1729 when '_' | '0' | '/' => Skip;
1732 Pic.Picture.Expanded (Index) := 'b';
1736 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1737 Pic.End_Float := Index;
1746 when '_' | '0' | '/' =>
1750 Pic.Picture.Expanded (Index) := 'b';
1754 Pic.Max_Trailing_Digits :=
1755 Pic.Max_Trailing_Digits + 1;
1756 Pic.End_Float := Index;
1769 end Number_Fraction_Or_Bracket;
1771 -------------------------------
1772 -- Number_Fraction_Or_Dollar --
1773 -------------------------------
1775 procedure Number_Fraction_Or_Dollar is
1777 Debug_Start ("Number_Fraction_Or_Dollar");
1785 when '_' | '0' | '/' =>
1789 Pic.Picture.Expanded (Index) := 'b';
1793 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1794 Pic.End_Float := Index;
1803 when '_' | '0' | '/' =>
1807 Pic.Picture.Expanded (Index) := 'b';
1811 Pic.Max_Trailing_Digits :=
1812 Pic.Max_Trailing_Digits + 1;
1813 Pic.End_Float := Index;
1826 end Number_Fraction_Or_Dollar;
1828 ------------------------------
1829 -- Number_Fraction_Or_Pound --
1830 ------------------------------
1832 procedure Number_Fraction_Or_Pound is
1841 when '_' | '0' | '/' =>
1845 Pic.Picture.Expanded (Index) := 'b';
1849 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1850 Pic.End_Float := Index;
1860 when '_' | '0' | '/' =>
1864 Pic.Picture.Expanded (Index) := 'b';
1868 Pic.Max_Trailing_Digits :=
1869 Pic.Max_Trailing_Digits + 1;
1870 Pic.End_Float := Index;
1885 end Number_Fraction_Or_Pound;
1887 ----------------------------------
1888 -- Number_Fraction_Or_Star_Fill --
1889 ----------------------------------
1891 procedure Number_Fraction_Or_Star_Fill is
1893 Debug_Start ("Number_Fraction_Or_Star_Fill");
1902 when '_' | '0' | '/' =>
1906 Pic.Picture.Expanded (Index) := 'b';
1910 Pic.Star_Fill := True;
1911 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1912 Pic.End_Float := Index;
1922 when '_' | '0' | '/' =>
1926 Pic.Picture.Expanded (Index) := 'b';
1930 Pic.Star_Fill := True;
1931 Pic.Max_Trailing_Digits :=
1932 Pic.Max_Trailing_Digits + 1;
1933 Pic.End_Float := Index;
1947 end Number_Fraction_Or_Star_Fill;
1949 -------------------------------
1950 -- Number_Fraction_Or_Z_Fill --
1951 -------------------------------
1953 procedure Number_Fraction_Or_Z_Fill is
1955 Debug_Start ("Number_Fraction_Or_Z_Fill");
1964 when '_' | '0' | '/' =>
1968 Pic.Picture.Expanded (Index) := 'b';
1972 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1973 Pic.End_Float := Index;
1974 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1985 when '_' | '0' | '/' =>
1989 Pic.Picture.Expanded (Index) := 'b';
1993 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1995 Pic.Max_Trailing_Digits :=
1996 Pic.Max_Trailing_Digits + 1;
1997 Pic.End_Float := Index;
2010 end Number_Fraction_Or_Z_Fill;
2012 -----------------------
2013 -- Optional_RHS_Sign --
2014 -----------------------
2016 procedure Optional_RHS_Sign is
2018 Debug_Start ("Optional_RHS_Sign");
2027 Pic.Sign_Position := Index;
2032 Pic.Sign_Position := Index;
2033 Pic.Picture.Expanded (Index) := 'C';
2036 if Look = 'R' or else Look = 'r' then
2037 Pic.Second_Sign := Index;
2038 Pic.Picture.Expanded (Index) := 'R';
2042 raise Picture_Error;
2048 Pic.Sign_Position := Index;
2049 Pic.Picture.Expanded (Index) := 'D';
2052 if Look = 'B' or else Look = 'b' then
2053 Pic.Second_Sign := Index;
2054 Pic.Picture.Expanded (Index) := 'B';
2058 raise Picture_Error;
2064 if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
2065 Pic.Second_Sign := Index;
2069 raise Picture_Error;
2076 end Optional_RHS_Sign;
2082 -- Note that Picture can be called in either State
2084 -- It will set state to Valid only if a 9 is encountered or floating
2085 -- currency is called.
2087 procedure Picture is
2089 Debug_Start ("Picture");
2098 when '_' | '0' | '/' =>
2102 Pic.Picture.Expanded (Index) := 'b';
2114 Computed_BWZ := False;
2116 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2119 when 'V' | 'v' | '.' =>
2120 Pic.Radix_Position := Index;
2133 ---------------------
2134 -- Picture_Bracket --
2135 ---------------------
2137 procedure Picture_Bracket is
2139 Pic.Sign_Position := Index;
2140 Debug_Start ("Picture_Bracket");
2141 Pic.Sign_Position := Index;
2143 -- Treat as a floating sign, and unwind otherwise
2146 Pic.Start_Float := Index;
2147 Pic.End_Float := Index;
2149 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2152 Skip; -- Known Bracket
2157 when '_' | '0' | '/' =>
2158 Pic.End_Float := Index;
2162 Pic.End_Float := Index;
2163 Pic.Picture.Expanded (Index) := 'b';
2167 Set_State (Okay); -- "<<>" is enough.
2173 when '$' | '#' | '9' | '*' =>
2174 if State /= Okay then
2176 Pic.Start_Float := Invalid_Position;
2177 Pic.End_Float := Invalid_Position;
2185 when '.' | 'V' | 'v' =>
2186 if State /= Okay then
2188 Pic.Start_Float := Invalid_Position;
2189 Pic.End_Float := Invalid_Position;
2192 -- Don't assume that state is okay, haven't seen a digit
2199 raise Picture_Error;
2203 end Picture_Bracket;
2209 procedure Picture_Minus is
2211 Debug_Start ("Picture_Minus");
2213 Pic.Sign_Position := Index;
2215 -- Treat as a floating sign, and unwind otherwise
2218 Pic.Start_Float := Index;
2219 Pic.End_Float := Index;
2221 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2224 Skip; -- Known Minus
2229 when '_' | '0' | '/' =>
2230 Pic.End_Float := Index;
2234 Pic.End_Float := Index;
2235 Pic.Picture.Expanded (Index) := 'b';
2239 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2240 Pic.End_Float := Index;
2242 Set_State (Okay); -- "-- " is enough.
2247 when '$' | '#' | '9' | '*' =>
2248 if State /= Okay then
2250 Pic.Start_Float := Invalid_Position;
2251 Pic.End_Float := Invalid_Position;
2260 -- Can't have Z and a floating sign
2262 if State = Okay then
2266 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2272 when '.' | 'V' | 'v' =>
2273 if State /= Okay then
2275 Pic.Start_Float := Invalid_Position;
2276 Pic.End_Float := Invalid_Position;
2279 -- Don't assume that state is okay, haven't seen a digit
2295 procedure Picture_Plus is
2297 Debug_Start ("Picture_Plus");
2298 Pic.Sign_Position := Index;
2300 -- Treat as a floating sign, and unwind otherwise
2303 Pic.Start_Float := Index;
2304 Pic.End_Float := Index;
2306 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2314 when '_' | '0' | '/' =>
2315 Pic.End_Float := Index;
2319 Pic.End_Float := Index;
2320 Pic.Picture.Expanded (Index) := 'b';
2324 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2325 Pic.End_Float := Index;
2327 Set_State (Okay); -- "++" is enough
2332 when '$' | '#' | '9' | '*' =>
2333 if State /= Okay then
2335 Pic.Start_Float := Invalid_Position;
2336 Pic.End_Float := Invalid_Position;
2344 if State = Okay then
2348 -- Can't have Z and a floating sign
2350 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2352 -- '+Z' is acceptable
2356 -- Overwrite Floater and Start_Float
2359 Pic.Start_Float := Index;
2366 when '.' | 'V' | 'v' =>
2367 if State /= Okay then
2369 Pic.Start_Float := Invalid_Position;
2370 Pic.End_Float := Invalid_Position;
2373 -- Don't assume that state is okay, haven't seen a digit
2385 --------------------
2386 -- Picture_String --
2387 --------------------
2389 procedure Picture_String is
2391 Debug_Start ("Picture_String");
2393 while Is_Insert loop
2413 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2423 when '9' | '.' | 'V' | 'v' =>
2429 raise Picture_Error;
2433 -- Blank when zero either if the PIC does not contain a '9' or if
2434 -- requested by the user and no '*'.
2436 Pic.Blank_When_Zero :=
2437 (Computed_BWZ or else Pic.Blank_When_Zero)
2438 and then not Pic.Star_Fill;
2440 -- Star fill if '*' and no '9'
2442 Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ;
2454 procedure Set_State (L : Legality) is
2457 Ada.Text_IO.Put_Line
2458 (" Set state from " & Legality'Image (State)
2459 & " to " & Legality'Image (L));
2472 Ada.Text_IO.Put_Line (" Skip " & Pic.Picture.Expanded (Index));
2478 ----------------------
2479 -- Star_Suppression --
2480 ----------------------
2482 procedure Star_Suppression is
2484 Debug_Start ("Star_Suppression");
2486 if Pic.Floater /= '!' and then Pic.Floater /= '*' then
2488 -- Two floats not allowed
2490 raise Picture_Error;
2496 Pic.Start_Float := Index;
2497 Pic.End_Float := Index;
2498 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2501 -- Even a single * is a valid picture
2503 Pic.Star_Fill := True;
2513 when '_' | '0' | '/' =>
2514 Pic.End_Float := Index;
2518 Pic.End_Float := Index;
2519 Pic.Picture.Expanded (Index) := 'b';
2523 Pic.End_Float := Index;
2524 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2525 Set_State (Okay); Skip;
2532 when '.' | 'V' | 'v' =>
2533 Pic.Radix_Position := Index;
2535 Number_Fraction_Or_Star_Fill;
2539 if Pic.Max_Currency_Digits > 0 then
2540 raise Picture_Error;
2543 -- Cannot have leading and trailing currency
2549 when others => raise Picture_Error;
2552 end Star_Suppression;
2554 ----------------------
2555 -- Trailing_Bracket --
2556 ----------------------
2558 procedure Trailing_Bracket is
2560 Debug_Start ("Trailing_Bracket");
2563 Pic.Second_Sign := Index;
2566 raise Picture_Error;
2568 end Trailing_Bracket;
2570 -----------------------
2571 -- Trailing_Currency --
2572 -----------------------
2574 procedure Trailing_Currency is
2576 Debug_Start ("Trailing_Currency");
2583 Pic.Start_Currency := Index;
2584 Pic.End_Currency := Index;
2588 while not At_End and then Look = '#' loop
2589 if Pic.Start_Currency = Invalid_Position then
2590 Pic.Start_Currency := Index;
2593 Pic.End_Currency := Index;
2604 when '_' | '0' | '/' => Skip;
2607 Pic.Picture.Expanded (Index) := 'b';
2610 when others => return;
2613 end Trailing_Currency;
2615 ----------------------
2616 -- Zero_Suppression --
2617 ----------------------
2619 procedure Zero_Suppression is
2621 Debug_Start ("Zero_Suppression");
2624 Pic.Start_Float := Index;
2625 Pic.End_Float := Index;
2626 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2627 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2632 -- Even a single Z is a valid picture
2640 when '_' | '0' | '/' =>
2641 Pic.End_Float := Index;
2645 Pic.End_Float := Index;
2646 Pic.Picture.Expanded (Index) := 'b';
2650 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2652 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2653 Pic.End_Float := Index;
2662 when '.' | 'V' | 'v' =>
2663 Pic.Radix_Position := Index;
2665 Number_Fraction_Or_Z_Fill;
2677 end Zero_Suppression;
2679 -- Start of processing for Precalculate
2682 pragma Debug (Set_Debug);
2687 Ada.Text_IO.New_Line;
2688 Ada.Text_IO.Put (" Picture : """ &
2689 Pic.Picture.Expanded (1 .. Pic.Picture.Length) & """,");
2690 Ada.Text_IO.Put (" Floater : '" & Pic.Floater & "',");
2693 if State = Reject then
2694 raise Picture_Error;
2697 Debug_Integer (Pic.Radix_Position, "Radix Positon : ");
2698 Debug_Integer (Pic.Sign_Position, "Sign Positon : ");
2699 Debug_Integer (Pic.Second_Sign, "Second Sign : ");
2700 Debug_Integer (Pic.Start_Float, "Start Float : ");
2701 Debug_Integer (Pic.End_Float, "End Float : ");
2702 Debug_Integer (Pic.Start_Currency, "Start Currency : ");
2703 Debug_Integer (Pic.End_Currency, "End Currency : ");
2704 Debug_Integer (Pic.Max_Leading_Digits, "Max Leading Digits : ");
2705 Debug_Integer (Pic.Max_Trailing_Digits, "Max Trailing Digits : ");
2708 Ada.Text_IO.New_Line;
2713 when Constraint_Error =>
2715 -- To deal with special cases like null strings
2717 raise Picture_Error;
2725 (Pic_String : String;
2726 Blank_When_Zero : Boolean := False) return Picture
2732 Item : constant String := Expand (Pic_String);
2735 Result.Contents.Picture := (Item'Length, Item);
2736 Result.Contents.Original_BWZ := Blank_When_Zero;
2737 Result.Contents.Blank_When_Zero := Blank_When_Zero;
2738 Precalculate (Result.Contents);
2744 raise Picture_Error;
2752 (Pic_String : String;
2753 Blank_When_Zero : Boolean := False) return Boolean
2757 Expanded_Pic : constant String := Expand (Pic_String);
2758 -- Raises Picture_Error if Item not well-formed
2760 Format_Rec : Format_Record;
2763 Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2764 Format_Rec.Blank_When_Zero := Blank_When_Zero;
2765 Format_Rec.Original_BWZ := Blank_When_Zero;
2766 Precalculate (Format_Rec);
2768 -- False only if Blank_When_Zero is True but the pic string has a '*'
2770 return not Blank_When_Zero
2771 or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2775 when others => return False;
2778 --------------------
2779 -- Decimal_Output --
2780 --------------------
2782 package body Decimal_Output is
2791 Currency : String := Default_Currency;
2792 Fill : Character := Default_Fill;
2793 Separator : Character := Default_Separator;
2794 Radix_Mark : Character := Default_Radix_Mark) return String
2797 return Format_Number
2798 (Pic.Contents, Num'Image (Item),
2799 Currency, Fill, Separator, Radix_Mark);
2808 Currency : String := Default_Currency) return Natural
2810 Picstr : constant String := Pic_String (Pic);
2811 V_Adjust : Integer := 0;
2812 Cur_Adjust : Integer := 0;
2815 -- Check if Picstr has 'V' or '$'
2817 -- If 'V', then length is 1 less than otherwise
2819 -- If '$', then length is Currency'Length-1 more than otherwise
2821 -- This should use the string handling package ???
2823 for J in Picstr'Range loop
2824 if Picstr (J) = 'V' then
2827 elsif Picstr (J) = '$' then
2828 Cur_Adjust := Currency'Length - 1;
2832 return Picstr'Length - V_Adjust + Cur_Adjust;
2840 (File : Text_IO.File_Type;
2843 Currency : String := Default_Currency;
2844 Fill : Character := Default_Fill;
2845 Separator : Character := Default_Separator;
2846 Radix_Mark : Character := Default_Radix_Mark)
2849 Text_IO.Put (File, Image (Item, Pic,
2850 Currency, Fill, Separator, Radix_Mark));
2856 Currency : String := Default_Currency;
2857 Fill : Character := Default_Fill;
2858 Separator : Character := Default_Separator;
2859 Radix_Mark : Character := Default_Radix_Mark)
2862 Text_IO.Put (Image (Item, Pic,
2863 Currency, Fill, Separator, Radix_Mark));
2870 Currency : String := Default_Currency;
2871 Fill : Character := Default_Fill;
2872 Separator : Character := Default_Separator;
2873 Radix_Mark : Character := Default_Radix_Mark)
2875 Result : constant String :=
2876 Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
2879 if Result'Length > To'Length then
2880 raise Ada.Text_IO.Layout_Error;
2882 Strings_Fixed.Move (Source => Result, Target => To,
2883 Justify => Strings.Right);
2894 Currency : String := Default_Currency) return Boolean
2898 Temp : constant String := Image (Item, Pic, Currency);
2899 pragma Warnings (Off, Temp);
2905 when Ada.Text_IO.Layout_Error => return False;
2910 end Ada.Text_IO.Editing;