1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . W I D E _ T E X T _ I O . E D I T I N G --
9 -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada.Strings.Fixed;
35 with Ada.Strings.Wide_Fixed;
37 package body Ada.Wide_Text_IO.Editing is
39 package Strings renames Ada.Strings;
40 package Strings_Fixed renames Ada.Strings.Fixed;
41 package Strings_Wide_Fixed renames Ada.Strings.Wide_Fixed;
42 package Wide_Text_IO renames Ada.Wide_Text_IO;
44 -----------------------
45 -- Local_Subprograms --
46 -----------------------
48 function To_Wide (C : Character) return Wide_Character;
49 pragma Inline (To_Wide);
50 -- Convert Character to corresponding Wide_Character
56 function Blank_When_Zero (Pic : Picture) return Boolean is
58 return Pic.Contents.Original_BWZ;
65 package body Decimal_Output is
74 Currency : Wide_String := Default_Currency;
75 Fill : Wide_Character := Default_Fill;
76 Separator : Wide_Character := Default_Separator;
77 Radix_Mark : Wide_Character := Default_Radix_Mark) return Wide_String
81 (Pic.Contents, Num'Image (Item),
82 Currency, Fill, Separator, Radix_Mark);
91 Currency : Wide_String := Default_Currency) return Natural
93 Picstr : constant String := Pic_String (Pic);
94 V_Adjust : Integer := 0;
95 Cur_Adjust : Integer := 0;
98 -- Check if Picstr has 'V' or '$'
100 -- If 'V', then length is 1 less than otherwise
102 -- If '$', then length is Currency'Length-1 more than otherwise
104 -- This should use the string handling package ???
106 for J in Picstr'Range loop
107 if Picstr (J) = 'V' then
110 elsif Picstr (J) = '$' then
111 Cur_Adjust := Currency'Length - 1;
115 return Picstr'Length - V_Adjust + Cur_Adjust;
123 (File : Wide_Text_IO.File_Type;
126 Currency : Wide_String := Default_Currency;
127 Fill : Wide_Character := Default_Fill;
128 Separator : Wide_Character := Default_Separator;
129 Radix_Mark : Wide_Character := Default_Radix_Mark)
132 Wide_Text_IO.Put (File, Image (Item, Pic,
133 Currency, Fill, Separator, Radix_Mark));
139 Currency : Wide_String := Default_Currency;
140 Fill : Wide_Character := Default_Fill;
141 Separator : Wide_Character := Default_Separator;
142 Radix_Mark : Wide_Character := Default_Radix_Mark)
145 Wide_Text_IO.Put (Image (Item, Pic,
146 Currency, Fill, Separator, Radix_Mark));
150 (To : out Wide_String;
153 Currency : Wide_String := Default_Currency;
154 Fill : Wide_Character := Default_Fill;
155 Separator : Wide_Character := Default_Separator;
156 Radix_Mark : Wide_Character := Default_Radix_Mark)
158 Result : constant Wide_String :=
159 Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
162 if Result'Length > To'Length then
163 raise Wide_Text_IO.Layout_Error;
165 Strings_Wide_Fixed.Move (Source => Result, Target => To,
166 Justify => Strings.Right);
177 Currency : Wide_String := Default_Currency) return Boolean
181 Temp : constant Wide_String := Image (Item, Pic, Currency);
182 pragma Warnings (Off, Temp);
188 when Layout_Error => return False;
197 function Expand (Picture : String) return String is
198 Result : String (1 .. MAX_PICSIZE);
199 Picture_Index : Integer := Picture'First;
200 Result_Index : Integer := Result'First;
205 if Picture'Length < 1 then
209 if Picture (Picture'First) = '(' then
214 case Picture (Picture_Index) is
218 -- We now need to scan out the count after a left paren. In
219 -- the non-wide version we used Integer_IO.Get, but that is
220 -- not convenient here, since we don't want to drag in normal
221 -- Text_IO just for this purpose. So we do the scan ourselves,
222 -- with the normal validity checks.
224 Last := Picture_Index + 1;
227 if Picture (Last) not in '0' .. '9' then
231 Count := Character'Pos (Picture (Last)) - Character'Pos ('0');
235 if Last > Picture'Last then
239 if Picture (Last) = '_' then
240 if Picture (Last - 1) = '_' then
244 elsif Picture (Last) = ')' then
247 elsif Picture (Last) not in '0' .. '9' then
252 + Character'Pos (Picture (Last)) -
259 -- In what follows note that one copy of the repeated
260 -- character has already been made, so a count of one is
261 -- no-op, and a count of zero erases a character.
263 for J in 2 .. Count loop
264 Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
267 Result_Index := Result_Index + Count - 1;
269 -- Last was a ')' throw it away too
271 Picture_Index := Last + 1;
277 Result (Result_Index) := Picture (Picture_Index);
278 Picture_Index := Picture_Index + 1;
279 Result_Index := Result_Index + 1;
283 exit when Picture_Index > Picture'Last;
286 return Result (1 .. Result_Index - 1);
297 function Format_Number
298 (Pic : Format_Record;
300 Currency_Symbol : Wide_String;
301 Fill_Character : Wide_Character;
302 Separator_Character : Wide_Character;
303 Radix_Point : Wide_Character) return Wide_String
305 Attrs : Number_Attributes := Parse_Number_String (Number);
307 Rounded : String := Number;
309 Sign_Position : Integer := Pic.Sign_Position; -- may float.
311 Answer : Wide_String (1 .. Pic.Picture.Length);
313 Currency_Pos : Integer := Pic.Start_Currency;
315 Dollar : Boolean := False;
316 -- Overridden immediately if necessary
318 Zero : Boolean := True;
319 -- Set to False when a non-zero digit is output
323 -- If the picture has fewer decimal places than the number, the image
324 -- must be rounded according to the usual rules.
326 if Attrs.Has_Fraction then
328 R : constant Integer :=
329 (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
330 - Pic.Max_Trailing_Digits;
335 R_Pos := Rounded'Length - R;
337 if Rounded (R_Pos + 1) > '4' then
339 if Rounded (R_Pos) = '.' then
343 if Rounded (R_Pos) /= '9' then
344 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
346 Rounded (R_Pos) := '0';
350 if Rounded (R_Pos) = '.' then
354 if Rounded (R_Pos) /= '9' then
355 Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
358 Rounded (R_Pos) := '0';
363 -- The rounding may add a digit in front. Either the
364 -- leading blank or the sign (already captured) can be
368 Rounded (R_Pos) := '1';
369 Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
377 for J in Answer'Range loop
378 Answer (J) := To_Wide (Pic.Picture.Expanded (J));
381 if Pic.Start_Currency /= Invalid_Position then
382 Dollar := Answer (Pic.Start_Currency) = '$';
385 -- Fix up "direct inserts" outside the playing field. Set up as one
386 -- loop to do the beginning, one (reverse) loop to do the end.
390 exit when Last = Pic.Start_Float;
391 exit when Last = Pic.Radix_Position;
392 exit when Answer (Last) = '9';
394 case Answer (Last) is
397 Answer (Last) := Separator_Character;
400 Answer (Last) := ' ';
407 exit when Last = Answer'Last;
412 -- Now for the end...
414 for J in reverse Last .. Answer'Last loop
415 exit when J = Pic.Radix_Position;
417 -- Do this test First, Separator_Character can equal Pic.Floater
419 if Answer (J) = Pic.Floater then
426 Answer (J) := Separator_Character;
442 if Pic.Start_Currency /= -1
443 and then Answer (Pic.Start_Currency) = '#'
444 and then Pic.Floater /= '#'
446 if Currency_Symbol'Length >
447 Pic.End_Currency - Pic.Start_Currency + 1
451 elsif Currency_Symbol'Length =
452 Pic.End_Currency - Pic.Start_Currency + 1
454 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
457 elsif Pic.Radix_Position = Invalid_Position
458 or else Pic.Start_Currency < Pic.Radix_Position
460 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
462 Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
463 Pic.End_Currency) := Currency_Symbol;
466 Answer (Pic.Start_Currency .. Pic.End_Currency) :=
468 Answer (Pic.Start_Currency ..
469 Pic.Start_Currency + Currency_Symbol'Length - 1) :=
474 -- Fill in leading digits
476 if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
477 Pic.Max_Leading_Digits
482 if Pic.Radix_Position = Invalid_Position then
483 Position := Answer'Last;
485 Position := Pic.Radix_Position - 1;
488 for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
490 while Answer (Position) /= '9'
491 and Answer (Position) /= Pic.Floater
493 if Answer (Position) = '_' then
494 Answer (Position) := Separator_Character;
496 elsif Answer (Position) = 'b' then
497 Answer (Position) := ' ';
500 Position := Position - 1;
503 Answer (Position) := To_Wide (Rounded (J));
505 if Rounded (J) /= '0' then
509 Position := Position - 1;
514 if Pic.Start_Float = Invalid_Position then
516 -- No leading floats, but need to change '9' to '0', '_' to
517 -- Separator_Character and 'b' to ' '.
519 for J in Last .. Position loop
521 -- Last set when fixing the "uninteresting" leaders above.
522 -- Don't duplicate the work.
524 if Answer (J) = '9' then
527 elsif Answer (J) = '_' then
528 Answer (J) := Separator_Character;
530 elsif Answer (J) = 'b' then
537 elsif Pic.Floater = '<'
543 for J in Pic.End_Float .. Position loop -- May be null range
544 if Answer (J) = '9' then
547 elsif Answer (J) = '_' then
548 Answer (J) := Separator_Character;
550 elsif Answer (J) = 'b' then
556 if Position > Pic.End_Float then
557 Position := Pic.End_Float;
560 for J in Pic.Start_Float .. Position - 1 loop
564 Answer (Position) := Pic.Floater;
565 Sign_Position := Position;
567 elsif Pic.Floater = '$' then
569 for J in Pic.End_Float .. Position loop -- May be null range
570 if Answer (J) = '9' then
573 elsif Answer (J) = '_' then
574 Answer (J) := ' '; -- no separator before leftmost digit
576 elsif Answer (J) = 'b' then
581 if Position > Pic.End_Float then
582 Position := Pic.End_Float;
585 for J in Pic.Start_Float .. Position - 1 loop
589 Answer (Position) := Pic.Floater;
590 Currency_Pos := Position;
592 elsif Pic.Floater = '*' then
594 for J in Pic.End_Float .. Position loop -- May be null range
595 if Answer (J) = '9' then
598 elsif Answer (J) = '_' then
599 Answer (J) := Separator_Character;
601 elsif Answer (J) = 'b' then
606 if Position > Pic.End_Float then
607 Position := Pic.End_Float;
610 for J in Pic.Start_Float .. Position loop
615 if Pic.Floater = '#' then
616 Currency_Pos := Currency_Symbol'Length;
619 for J in reverse Pic.Start_Float .. Position loop
623 Answer (J) := Fill_Character;
625 when 'Z' | 'b' | '/' | '0' =>
631 when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
635 if Currency_Pos = 0 then
638 Answer (J) := Currency_Symbol (Currency_Pos);
639 Currency_Pos := Currency_Pos - 1;
647 Answer (J) := Fill_Character;
653 if Currency_Pos = 0 then
657 Answer (J) := Currency_Symbol (Currency_Pos);
658 Currency_Pos := Currency_Pos - 1;
672 if Pic.Floater = '#' and then Currency_Pos /= 0 then
679 if Sign_Position = Invalid_Position then
680 if Attrs.Negative then
685 if Attrs.Negative then
686 case Answer (Sign_Position) is
687 when 'C' | 'D' | '-' =>
691 Answer (Sign_Position) := '-';
694 Answer (Sign_Position) := '(';
695 Answer (Pic.Second_Sign) := ')';
704 case Answer (Sign_Position) is
707 Answer (Sign_Position) := ' ';
709 when '<' | 'C' | 'D' =>
710 Answer (Sign_Position) := ' ';
711 Answer (Pic.Second_Sign) := ' ';
723 -- Fill in trailing digits
725 if Pic.Max_Trailing_Digits > 0 then
727 if Attrs.Has_Fraction then
728 Position := Attrs.Start_Of_Fraction;
729 Last := Pic.Radix_Position + 1;
731 for J in Last .. Answer'Last loop
733 if Answer (J) = '9' or Answer (J) = Pic.Floater then
734 Answer (J) := To_Wide (Rounded (Position));
736 if Rounded (Position) /= '0' then
740 Position := Position + 1;
743 -- Used up fraction but remember place in Answer
745 exit when Position > Attrs.End_Of_Fraction;
747 elsif Answer (J) = 'b' then
750 elsif Answer (J) = '_' then
751 Answer (J) := Separator_Character;
761 Position := Pic.Radix_Position + 1;
764 -- Now fill remaining 9's with zeros and _ with separators
768 for J in Position .. Last loop
769 if Answer (J) = '9' then
772 elsif Answer (J) = Pic.Floater then
775 elsif Answer (J) = '_' then
776 Answer (J) := Separator_Character;
778 elsif Answer (J) = 'b' then
784 Position := Last + 1;
787 if Pic.Floater = '#' and then Currency_Pos /= 0 then
791 -- No trailing digits, but now J may need to stick in a currency
794 if Pic.Start_Currency = Invalid_Position then
795 Position := Answer'Last + 1;
797 Position := Pic.Start_Currency;
801 for J in Position .. Answer'Last loop
803 if Pic.Start_Currency /= Invalid_Position and then
804 Answer (Pic.Start_Currency) = '#' then
808 -- Note: There are some weird cases J can imagine with 'b' or '#'
809 -- in currency strings where the following code will cause
810 -- glitches. The trick is to tell when the character in the
811 -- answer should be checked, and when to look at the original
812 -- string. Some other time. RIE 11/26/96 ???
816 Answer (J) := Fill_Character;
822 if Currency_Pos > Currency_Symbol'Length then
826 Answer (J) := Currency_Symbol (Currency_Pos);
827 Currency_Pos := Currency_Pos + 1;
835 Answer (J) := Fill_Character;
841 if Currency_Pos > Currency_Symbol'Length then
844 Answer (J) := Currency_Symbol (Currency_Pos);
845 Currency_Pos := Currency_Pos + 1;
859 -- Now get rid of Blank_when_Zero and complete Star fill
861 if Zero and Pic.Blank_When_Zero then
863 -- Value is zero, and blank it
868 Last := Last - 1 + Currency_Symbol'Length;
871 if Pic.Radix_Position /= Invalid_Position and then
872 Answer (Pic.Radix_Position) = 'V' then
876 return Wide_String'(1 .. Last => ' ');
878 elsif Zero and Pic.Star_Fill then
882 Last := Last - 1 + Currency_Symbol'Length;
885 if Pic.Radix_Position /= Invalid_Position then
887 if Answer (Pic.Radix_Position) = 'V' then
891 if Pic.Radix_Position > Pic.Start_Currency then
892 return Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
894 Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
900 Pic.Radix_Position + Currency_Symbol'Length - 2
904 (Pic.Radix_Position + Currency_Symbol'Length .. Last
910 Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
912 Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
916 return Wide_String'(1 .. Last => '*');
919 -- This was once a simple return statement, now there are nine
920 -- different return cases. Not to mention the five above to deal
921 -- with zeros. Why not split things out?
923 -- Processing the radix and sign expansion separately
924 -- would require lots of copying--the string and some of its
925 -- indicies--without really simplifying the logic. The cases are:
927 -- 1) Expand $, replace '.' with Radix_Point
928 -- 2) No currency expansion, replace '.' with Radix_Point
929 -- 3) Expand $, radix blanked
930 -- 4) No currency expansion, radix blanked
932 -- 6) Expand $, Elide V
933 -- 7) Elide V, Expand $ (Two cases depending on order.)
934 -- 8) No radix, expand $
935 -- 9) No radix, no currency expansion
937 if Pic.Radix_Position /= Invalid_Position then
939 if Answer (Pic.Radix_Position) = '.' then
940 Answer (Pic.Radix_Position) := Radix_Point;
944 -- 1) Expand $, replace '.' with Radix_Point
946 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
947 Answer (Currency_Pos + 1 .. Answer'Last);
950 -- 2) No currency expansion, replace '.' with Radix_Point
955 elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix.
958 -- 3) Expand $, radix blanked
960 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
961 Answer (Currency_Pos + 1 .. Answer'Last);
964 -- 4) No expansion, radix blanked
976 return Answer (1 .. Pic.Radix_Position - 1) &
977 Answer (Pic.Radix_Position + 1 .. Answer'Last);
979 elsif Currency_Pos < Pic.Radix_Position then
981 -- 6) Expand $, Elide V
983 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
984 Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
985 Answer (Pic.Radix_Position + 1 .. Answer'Last);
988 -- 7) Elide V, Expand $
990 return Answer (1 .. Pic.Radix_Position - 1) &
991 Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
993 Answer (Currency_Pos + 1 .. Answer'Last);
999 -- 8) No radix, expand $
1001 return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
1002 Answer (Currency_Pos + 1 .. Answer'Last);
1005 -- 9) No radix, no currency expansion
1011 -------------------------
1012 -- Parse_Number_String --
1013 -------------------------
1015 function Parse_Number_String (Str : String) return Number_Attributes is
1016 Answer : Number_Attributes;
1019 for J in Str'Range loop
1027 -- Decide if this is the start of a number.
1028 -- If so, figure out which one...
1030 if Answer.Has_Fraction then
1031 Answer.End_Of_Fraction := J;
1033 if Answer.Start_Of_Int = Invalid_Position then
1035 Answer.Start_Of_Int := J;
1037 Answer.End_Of_Int := J;
1042 -- Only count a zero before the decimal point if it follows a
1043 -- non-zero digit. After the decimal point, zeros will be
1044 -- counted if followed by a non-zero digit.
1046 if not Answer.Has_Fraction then
1047 if Answer.Start_Of_Int /= Invalid_Position then
1048 Answer.End_Of_Int := J;
1056 Answer.Negative := True;
1060 -- Close integer, start fraction
1062 if Answer.Has_Fraction then
1063 raise Picture_Error;
1066 -- Two decimal points is a no-no
1068 Answer.Has_Fraction := True;
1069 Answer.End_Of_Fraction := J;
1071 -- Could leave this at Invalid_Position, but this seems the
1072 -- right way to indicate a null range...
1074 Answer.Start_Of_Fraction := J + 1;
1075 Answer.End_Of_Int := J - 1;
1078 raise Picture_Error; -- can this happen? probably not!
1082 if Answer.Start_Of_Int = Invalid_Position then
1083 Answer.Start_Of_Int := Answer.End_Of_Int + 1;
1086 -- No significant (intger) digits needs a null range
1089 end Parse_Number_String;
1095 -- The following ensures that we return B and not b being careful not
1096 -- to break things which expect lower case b for blank. See CXF3A02.
1098 function Pic_String (Pic : Picture) return String is
1099 Temp : String (1 .. Pic.Contents.Picture.Length) :=
1100 Pic.Contents.Picture.Expanded;
1102 for J in Temp'Range loop
1103 if Temp (J) = 'b' then Temp (J) := 'B'; end if;
1113 procedure Precalculate (Pic : in out Format_Record) is
1115 Computed_BWZ : Boolean := True;
1117 type Legality is (Okay, Reject);
1118 State : Legality := Reject;
1119 -- Start in reject, which will reject null strings
1121 Index : Pic_Index := Pic.Picture.Expanded'First;
1123 function At_End return Boolean;
1124 pragma Inline (At_End);
1126 procedure Set_State (L : Legality);
1127 pragma Inline (Set_State);
1129 function Look return Character;
1130 pragma Inline (Look);
1132 function Is_Insert return Boolean;
1133 pragma Inline (Is_Insert);
1136 pragma Inline (Skip);
1138 procedure Trailing_Currency;
1139 procedure Trailing_Bracket;
1140 procedure Number_Fraction;
1141 procedure Number_Completion;
1142 procedure Number_Fraction_Or_Bracket;
1143 procedure Number_Fraction_Or_Z_Fill;
1144 procedure Zero_Suppression;
1145 procedure Floating_Bracket;
1146 procedure Number_Fraction_Or_Star_Fill;
1147 procedure Star_Suppression;
1148 procedure Number_Fraction_Or_Dollar;
1149 procedure Leading_Dollar;
1150 procedure Number_Fraction_Or_Pound;
1151 procedure Leading_Pound;
1153 procedure Floating_Plus;
1154 procedure Floating_Minus;
1155 procedure Picture_Plus;
1156 procedure Picture_Minus;
1157 procedure Picture_Bracket;
1159 procedure Optional_RHS_Sign;
1160 procedure Picture_String;
1166 function At_End return Boolean is
1168 return Index > Pic.Picture.Length;
1171 ----------------------
1172 -- Floating_Bracket --
1173 ----------------------
1175 -- Note that Floating_Bracket is only called with an acceptable
1176 -- prefix. But we don't set Okay, because we must end with a '>'.
1178 procedure Floating_Bracket is
1181 Pic.End_Float := Index;
1182 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1184 -- First bracket wasn't counted...
1195 when '_' | '0' | '/' =>
1196 Pic.End_Float := Index;
1200 Pic.End_Float := Index;
1201 Pic.Picture.Expanded (Index) := 'b';
1205 Pic.End_Float := Index;
1206 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1218 when 'V' | 'v' | '.' =>
1219 Pic.Radix_Position := Index;
1221 Number_Fraction_Or_Bracket;
1228 end Floating_Bracket;
1230 --------------------
1231 -- Floating_Minus --
1232 --------------------
1234 procedure Floating_Minus is
1242 when '_' | '0' | '/' =>
1243 Pic.End_Float := Index;
1247 Pic.End_Float := Index;
1248 Pic.Picture.Expanded (Index) := 'b';
1252 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1253 Pic.End_Float := Index;
1260 when '.' | 'V' | 'v' =>
1261 Pic.Radix_Position := Index;
1264 while Is_Insert loop
1281 Pic.Max_Trailing_Digits :=
1282 Pic.Max_Trailing_Digits + 1;
1283 Pic.End_Float := Index;
1286 when '_' | '0' | '/' =>
1290 Pic.Picture.Expanded (Index) := 'b';
1315 procedure Floating_Plus is
1323 when '_' | '0' | '/' =>
1324 Pic.End_Float := Index;
1328 Pic.End_Float := Index;
1329 Pic.Picture.Expanded (Index) := 'b';
1333 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1334 Pic.End_Float := Index;
1341 when '.' | 'V' | 'v' =>
1342 Pic.Radix_Position := Index;
1345 while Is_Insert loop
1362 Pic.Max_Trailing_Digits :=
1363 Pic.Max_Trailing_Digits + 1;
1364 Pic.End_Float := Index;
1367 when '_' | '0' | '/' =>
1371 Pic.Picture.Expanded (Index) := 'b';
1397 function Is_Insert return Boolean is
1403 case Pic.Picture.Expanded (Index) is
1405 when '_' | '0' | '/' => return True;
1408 Pic.Picture.Expanded (Index) := 'b'; -- canonical
1411 when others => return False;
1415 --------------------
1416 -- Leading_Dollar --
1417 --------------------
1419 -- Note that Leading_Dollar can be called in either State.
1420 -- It will set state to Okay only if a 9 or (second) $
1423 -- Also notice the tricky bit with State and Zero_Suppression.
1424 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1425 -- encountered, exactly the cases where State has been set.
1427 procedure Leading_Dollar is
1429 -- Treat as a floating dollar, and unwind otherwise
1432 Pic.Start_Currency := Index;
1433 Pic.End_Currency := Index;
1434 Pic.Start_Float := Index;
1435 Pic.End_Float := Index;
1437 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1449 when '_' | '0' | '/' =>
1450 Pic.End_Float := Index;
1453 -- A trailing insertion character is not part of the
1454 -- floating currency, so need to look ahead.
1457 Pic.End_Float := Pic.End_Float - 1;
1461 Pic.End_Float := Index;
1462 Pic.Picture.Expanded (Index) := 'b';
1466 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1468 if State = Okay then
1469 raise Picture_Error;
1471 -- Will overwrite Floater and Start_Float
1477 if State = Okay then
1478 raise Picture_Error;
1480 -- Will overwrite Floater and Start_Float
1486 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1487 Pic.End_Float := Index;
1488 Pic.End_Currency := Index;
1489 Set_State (Okay); Skip;
1492 if State /= Okay then
1494 Pic.Start_Float := Invalid_Position;
1495 Pic.End_Float := Invalid_Position;
1498 -- A single dollar does not a floating make
1503 when 'V' | 'v' | '.' =>
1504 if State /= Okay then
1506 Pic.Start_Float := Invalid_Position;
1507 Pic.End_Float := Invalid_Position;
1510 -- Only one dollar before the sign is okay, but doesn't
1513 Pic.Radix_Position := Index;
1515 Number_Fraction_Or_Dollar;
1529 -- This one is complex! A Leading_Pound can be fixed or floating,
1530 -- but in some cases the decision has to be deferred until we leave
1531 -- this procedure. Also note that Leading_Pound can be called in
1534 -- It will set state to Okay only if a 9 or (second) # is
1537 -- One Last note: In ambiguous cases, the currency is treated as
1538 -- floating unless there is only one '#'.
1540 procedure Leading_Pound is
1542 Inserts : Boolean := False;
1543 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1545 Must_Float : Boolean := False;
1546 -- Set to true if a '#' occurs after an insert
1549 -- Treat as a floating currency. If it isn't, this will be
1550 -- overwritten later.
1554 Pic.Start_Currency := Index;
1555 Pic.End_Currency := Index;
1556 Pic.Start_Float := Index;
1557 Pic.End_Float := Index;
1559 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1562 Pic.Max_Currency_Digits := 1; -- we've seen one.
1573 when '_' | '0' | '/' =>
1574 Pic.End_Float := Index;
1579 Pic.Picture.Expanded (Index) := 'b';
1580 Pic.End_Float := Index;
1585 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1588 raise Picture_Error;
1590 Pic.Max_Leading_Digits := 0;
1592 -- Will overwrite Floater and Start_Float
1599 raise Picture_Error;
1601 Pic.Max_Leading_Digits := 0;
1603 -- Will overwrite Floater and Start_Float
1613 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1614 Pic.End_Float := Index;
1615 Pic.End_Currency := Index;
1620 if State /= Okay then
1622 -- A single '#' doesn't float
1625 Pic.Start_Float := Invalid_Position;
1626 Pic.End_Float := Invalid_Position;
1632 when 'V' | 'v' | '.' =>
1633 if State /= Okay then
1635 Pic.Start_Float := Invalid_Position;
1636 Pic.End_Float := Invalid_Position;
1639 -- Only one pound before the sign is okay, but doesn't
1642 Pic.Radix_Position := Index;
1644 Number_Fraction_Or_Pound;
1657 function Look return Character is
1660 raise Picture_Error;
1663 return Pic.Picture.Expanded (Index);
1675 when '_' | '0' | '/' =>
1679 Pic.Picture.Expanded (Index) := 'b';
1683 Computed_BWZ := False;
1684 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1688 when '.' | 'V' | 'v' =>
1689 Pic.Radix_Position := Index;
1703 -- Will return in Okay state if a '9' was seen
1708 -----------------------
1709 -- Number_Completion --
1710 -----------------------
1712 procedure Number_Completion is
1714 while not At_End loop
1717 when '_' | '0' | '/' =>
1721 Pic.Picture.Expanded (Index) := 'b';
1725 Computed_BWZ := False;
1726 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1730 when 'V' | 'v' | '.' =>
1731 Pic.Radix_Position := Index;
1740 end Number_Completion;
1742 ---------------------
1743 -- Number_Fraction --
1744 ---------------------
1746 procedure Number_Fraction is
1748 -- Note that number fraction can be called in either State.
1749 -- It will set state to Valid only if a 9 is encountered.
1757 when '_' | '0' | '/' =>
1761 Pic.Picture.Expanded (Index) := 'b';
1765 Computed_BWZ := False;
1766 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1767 Set_State (Okay); Skip;
1773 end Number_Fraction;
1775 --------------------------------
1776 -- Number_Fraction_Or_Bracket --
1777 --------------------------------
1779 procedure Number_Fraction_Or_Bracket is
1788 when '_' | '0' | '/' => Skip;
1791 Pic.Picture.Expanded (Index) := 'b';
1795 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1796 Pic.End_Float := Index;
1805 when '_' | '0' | '/' =>
1809 Pic.Picture.Expanded (Index) := 'b';
1813 Pic.Max_Trailing_Digits :=
1814 Pic.Max_Trailing_Digits + 1;
1815 Pic.End_Float := Index;
1828 end Number_Fraction_Or_Bracket;
1830 -------------------------------
1831 -- Number_Fraction_Or_Dollar --
1832 -------------------------------
1834 procedure Number_Fraction_Or_Dollar is
1842 when '_' | '0' | '/' =>
1846 Pic.Picture.Expanded (Index) := 'b';
1850 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1851 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;
1883 end Number_Fraction_Or_Dollar;
1885 ------------------------------
1886 -- Number_Fraction_Or_Pound --
1887 ------------------------------
1889 procedure Number_Fraction_Or_Pound is
1898 when '_' | '0' | '/' =>
1902 Pic.Picture.Expanded (Index) := 'b';
1906 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1907 Pic.End_Float := Index;
1917 when '_' | '0' | '/' =>
1921 Pic.Picture.Expanded (Index) := 'b';
1925 Pic.Max_Trailing_Digits :=
1926 Pic.Max_Trailing_Digits + 1;
1927 Pic.End_Float := Index;
1942 end Number_Fraction_Or_Pound;
1944 ----------------------------------
1945 -- Number_Fraction_Or_Star_Fill --
1946 ----------------------------------
1948 procedure Number_Fraction_Or_Star_Fill is
1957 when '_' | '0' | '/' =>
1961 Pic.Picture.Expanded (Index) := 'b';
1965 Pic.Star_Fill := True;
1966 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1967 Pic.End_Float := Index;
1977 when '_' | '0' | '/' =>
1981 Pic.Picture.Expanded (Index) := 'b';
1985 Pic.Star_Fill := True;
1986 Pic.Max_Trailing_Digits :=
1987 Pic.Max_Trailing_Digits + 1;
1988 Pic.End_Float := Index;
2002 end Number_Fraction_Or_Star_Fill;
2004 -------------------------------
2005 -- Number_Fraction_Or_Z_Fill --
2006 -------------------------------
2008 procedure Number_Fraction_Or_Z_Fill is
2017 when '_' | '0' | '/' =>
2021 Pic.Picture.Expanded (Index) := 'b';
2025 Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
2026 Pic.End_Float := Index;
2027 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2038 when '_' | '0' | '/' =>
2042 Pic.Picture.Expanded (Index) := 'b';
2046 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2048 Pic.Max_Trailing_Digits :=
2049 Pic.Max_Trailing_Digits + 1;
2050 Pic.End_Float := Index;
2063 end Number_Fraction_Or_Z_Fill;
2065 -----------------------
2066 -- Optional_RHS_Sign --
2067 -----------------------
2069 procedure Optional_RHS_Sign is
2078 Pic.Sign_Position := Index;
2083 Pic.Sign_Position := Index;
2084 Pic.Picture.Expanded (Index) := 'C';
2087 if Look = 'R' or Look = 'r' then
2088 Pic.Second_Sign := Index;
2089 Pic.Picture.Expanded (Index) := 'R';
2093 raise Picture_Error;
2099 Pic.Sign_Position := Index;
2100 Pic.Picture.Expanded (Index) := 'D';
2103 if Look = 'B' or Look = 'b' then
2104 Pic.Second_Sign := Index;
2105 Pic.Picture.Expanded (Index) := 'B';
2109 raise Picture_Error;
2115 if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
2116 Pic.Second_Sign := Index;
2120 raise Picture_Error;
2127 end Optional_RHS_Sign;
2133 -- Note that Picture can be called in either State
2135 -- It will set state to Valid only if a 9 is encountered or floating
2136 -- currency is called.
2138 procedure Picture is
2147 when '_' | '0' | '/' =>
2151 Pic.Picture.Expanded (Index) := 'b';
2163 Computed_BWZ := False;
2165 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2168 when 'V' | 'v' | '.' =>
2169 Pic.Radix_Position := Index;
2182 ---------------------
2183 -- Picture_Bracket --
2184 ---------------------
2186 procedure Picture_Bracket is
2188 Pic.Sign_Position := Index;
2189 Pic.Sign_Position := Index;
2191 -- Treat as a floating sign, and unwind otherwise
2194 Pic.Start_Float := Index;
2195 Pic.End_Float := Index;
2197 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2200 Skip; -- Known Bracket
2205 when '_' | '0' | '/' =>
2206 Pic.End_Float := Index;
2210 Pic.End_Float := Index;
2211 Pic.Picture.Expanded (Index) := 'b';
2215 Set_State (Okay); -- "<<>" is enough.
2221 when '$' | '#' | '9' | '*' =>
2222 if State /= Okay then
2224 Pic.Start_Float := Invalid_Position;
2225 Pic.End_Float := Invalid_Position;
2233 when '.' | 'V' | 'v' =>
2234 if State /= Okay then
2236 Pic.Start_Float := Invalid_Position;
2237 Pic.End_Float := Invalid_Position;
2240 -- Don't assume that state is okay, haven't seen a digit
2247 raise Picture_Error;
2251 end Picture_Bracket;
2257 procedure Picture_Minus is
2259 Pic.Sign_Position := Index;
2261 -- Treat as a floating sign, and unwind otherwise
2264 Pic.Start_Float := Index;
2265 Pic.End_Float := Index;
2267 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2270 Skip; -- Known Minus
2275 when '_' | '0' | '/' =>
2276 Pic.End_Float := Index;
2280 Pic.End_Float := Index;
2281 Pic.Picture.Expanded (Index) := 'b';
2285 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2286 Pic.End_Float := Index;
2288 Set_State (Okay); -- "-- " is enough
2293 when '$' | '#' | '9' | '*' =>
2294 if State /= Okay then
2296 Pic.Start_Float := Invalid_Position;
2297 Pic.End_Float := Invalid_Position;
2306 -- Can't have Z and a floating sign
2308 if State = Okay then
2312 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2318 when '.' | 'V' | 'v' =>
2319 if State /= Okay then
2321 Pic.Start_Float := Invalid_Position;
2322 Pic.End_Float := Invalid_Position;
2325 -- Don't assume that state is okay, haven't seen a digit
2341 procedure Picture_Plus is
2343 Pic.Sign_Position := Index;
2345 -- Treat as a floating sign, and unwind otherwise
2348 Pic.Start_Float := Index;
2349 Pic.End_Float := Index;
2351 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2359 when '_' | '0' | '/' =>
2360 Pic.End_Float := Index;
2364 Pic.End_Float := Index;
2365 Pic.Picture.Expanded (Index) := 'b';
2369 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2370 Pic.End_Float := Index;
2372 Set_State (Okay); -- "++" is enough
2377 when '$' | '#' | '9' | '*' =>
2378 if State /= Okay then
2380 Pic.Start_Float := Invalid_Position;
2381 Pic.End_Float := Invalid_Position;
2389 if State = Okay then
2393 -- Can't have Z and a floating sign
2395 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2397 -- '+Z' is acceptable
2406 when '.' | 'V' | 'v' =>
2407 if State /= Okay then
2409 Pic.Start_Float := Invalid_Position;
2410 Pic.End_Float := Invalid_Position;
2413 -- Don't assume that state is okay, haven't seen a digit
2425 --------------------
2426 -- Picture_String --
2427 --------------------
2429 procedure Picture_String is
2431 while Is_Insert loop
2451 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2461 when '9' | '.' | 'V' | 'v' =>
2467 raise Picture_Error;
2471 -- Blank when zero either if the PIC does not contain a '9' or if
2472 -- requested by the user and no '*'
2474 Pic.Blank_When_Zero :=
2475 (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
2477 -- Star fill if '*' and no '9'
2479 Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
2491 procedure Set_State (L : Legality) is
2505 ----------------------
2506 -- Star_Suppression --
2507 ----------------------
2509 procedure Star_Suppression is
2512 Pic.Start_Float := Index;
2513 Pic.End_Float := Index;
2514 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2517 -- Even a single * is a valid picture
2519 Pic.Star_Fill := True;
2529 when '_' | '0' | '/' =>
2530 Pic.End_Float := Index;
2534 Pic.End_Float := Index;
2535 Pic.Picture.Expanded (Index) := 'b';
2539 Pic.End_Float := Index;
2540 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2541 Set_State (Okay); Skip;
2548 when '.' | 'V' | 'v' =>
2549 Pic.Radix_Position := Index;
2551 Number_Fraction_Or_Star_Fill;
2559 when others => raise Picture_Error;
2562 end Star_Suppression;
2564 ----------------------
2565 -- Trailing_Bracket --
2566 ----------------------
2568 procedure Trailing_Bracket is
2571 Pic.Second_Sign := Index;
2574 raise Picture_Error;
2576 end Trailing_Bracket;
2578 -----------------------
2579 -- Trailing_Currency --
2580 -----------------------
2582 procedure Trailing_Currency is
2589 Pic.Start_Currency := Index;
2590 Pic.End_Currency := Index;
2594 while not At_End and then Look = '#' loop
2595 if Pic.Start_Currency = Invalid_Position then
2596 Pic.Start_Currency := Index;
2599 Pic.End_Currency := Index;
2610 when '_' | '0' | '/' => Skip;
2613 Pic.Picture.Expanded (Index) := 'b';
2616 when others => return;
2619 end Trailing_Currency;
2621 ----------------------
2622 -- Zero_Suppression --
2623 ----------------------
2625 procedure Zero_Suppression is
2628 Pic.Start_Float := Index;
2629 Pic.End_Float := Index;
2630 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2631 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2636 -- Even a single Z is a valid picture
2644 when '_' | '0' | '/' =>
2645 Pic.End_Float := Index;
2649 Pic.End_Float := Index;
2650 Pic.Picture.Expanded (Index) := 'b';
2654 Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2656 Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2657 Pic.End_Float := Index;
2666 when '.' | 'V' | 'v' =>
2667 Pic.Radix_Position := Index;
2669 Number_Fraction_Or_Z_Fill;
2681 end Zero_Suppression;
2683 -- Start of processing for Precalculate
2688 if State = Reject then
2689 raise Picture_Error;
2694 when Constraint_Error =>
2696 -- To deal with special cases like null strings
2698 raise Picture_Error;
2707 (Pic_String : String;
2708 Blank_When_Zero : Boolean := False) return Picture
2714 Item : constant String := Expand (Pic_String);
2717 Result.Contents.Picture := (Item'Length, Item);
2718 Result.Contents.Original_BWZ := Blank_When_Zero;
2719 Result.Contents.Blank_When_Zero := Blank_When_Zero;
2720 Precalculate (Result.Contents);
2726 raise Picture_Error;
2734 function To_Wide (C : Character) return Wide_Character is
2736 return Wide_Character'Val (Character'Pos (C));
2744 (Pic_String : String;
2745 Blank_When_Zero : Boolean := False) return Boolean
2749 Expanded_Pic : constant String := Expand (Pic_String);
2750 -- Raises Picture_Error if Item not well-formed
2752 Format_Rec : Format_Record;
2755 Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2756 Format_Rec.Blank_When_Zero := Blank_When_Zero;
2757 Format_Rec.Original_BWZ := Blank_When_Zero;
2758 Precalculate (Format_Rec);
2760 -- False only if Blank_When_0 is True but the pic string has a '*'
2762 return not Blank_When_Zero
2763 or else Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2767 when others => return False;
2770 end Ada.Wide_Text_IO.Editing;