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