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 --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 ------------------------------------------------------------------------------
35 with Ada
.Strings
.Fixed
;
36 with Ada
.Strings
.Wide_Fixed
;
38 package body Ada
.Wide_Text_IO
.Editing
is
40 package Strings
renames Ada
.Strings
;
41 package Strings_Fixed
renames Ada
.Strings
.Fixed
;
42 package Strings_Wide_Fixed
renames Ada
.Strings
.Wide_Fixed
;
43 package Wide_Text_IO
renames Ada
.Wide_Text_IO
;
45 -----------------------
46 -- Local_Subprograms --
47 -----------------------
49 function To_Wide
(C
: Character) return Wide_Character;
50 pragma Inline
(To_Wide
);
51 -- Convert Character to corresponding Wide_Character
57 function Blank_When_Zero
(Pic
: in Picture
) return Boolean is
59 return Pic
.Contents
.Original_BWZ
;
66 package body Decimal_Output
is
75 Currency
: in Wide_String := Default_Currency
;
76 Fill
: in Wide_Character := Default_Fill
;
77 Separator
: in Wide_Character := Default_Separator
;
78 Radix_Mark
: in Wide_Character := Default_Radix_Mark
)
83 (Pic
.Contents
, Num
'Image (Item
),
84 Currency
, Fill
, Separator
, Radix_Mark
);
93 Currency
: in Wide_String := Default_Currency
)
96 Picstr
: constant String := Pic_String
(Pic
);
97 V_Adjust
: Integer := 0;
98 Cur_Adjust
: Integer := 0;
101 -- Check if Picstr has 'V' or '$'
103 -- If 'V', then length is 1 less than otherwise
105 -- If '$', then length is Currency'Length-1 more than otherwise
107 -- This should use the string handling package ???
109 for J
in Picstr
'Range loop
110 if Picstr
(J
) = 'V' then
113 elsif Picstr
(J
) = '$' then
114 Cur_Adjust
:= Currency
'Length - 1;
118 return Picstr
'Length - V_Adjust
+ Cur_Adjust
;
126 (File
: in Wide_Text_IO
.File_Type
;
129 Currency
: in Wide_String := Default_Currency
;
130 Fill
: in Wide_Character := Default_Fill
;
131 Separator
: in Wide_Character := Default_Separator
;
132 Radix_Mark
: in Wide_Character := Default_Radix_Mark
)
135 Wide_Text_IO
.Put
(File
, Image
(Item
, Pic
,
136 Currency
, Fill
, Separator
, Radix_Mark
));
142 Currency
: in Wide_String := Default_Currency
;
143 Fill
: in Wide_Character := Default_Fill
;
144 Separator
: in Wide_Character := Default_Separator
;
145 Radix_Mark
: in Wide_Character := Default_Radix_Mark
)
148 Wide_Text_IO
.Put
(Image
(Item
, Pic
,
149 Currency
, Fill
, Separator
, Radix_Mark
));
153 (To
: out Wide_String;
156 Currency
: in Wide_String := Default_Currency
;
157 Fill
: in Wide_Character := Default_Fill
;
158 Separator
: in Wide_Character := Default_Separator
;
159 Radix_Mark
: in Wide_Character := Default_Radix_Mark
)
161 Result
: constant Wide_String :=
162 Image
(Item
, Pic
, Currency
, Fill
, Separator
, Radix_Mark
);
165 if Result
'Length > To
'Length then
166 raise Wide_Text_IO
.Layout_Error
;
168 Strings_Wide_Fixed
.Move
(Source
=> Result
, Target
=> To
,
169 Justify
=> Strings
.Right
);
180 Currency
: in Wide_String := Default_Currency
)
185 Temp
: constant Wide_String := Image
(Item
, Pic
, Currency
);
186 pragma Warnings
(Off
, Temp
);
193 when Layout_Error
=> return False;
203 function Expand
(Picture
: in String) return String is
204 Result
: String (1 .. MAX_PICSIZE
);
205 Picture_Index
: Integer := Picture
'First;
206 Result_Index
: Integer := Result
'First;
211 if Picture
'Length < 1 then
215 if Picture
(Picture
'First) = '(' then
220 case Picture
(Picture_Index
) is
224 -- We now need to scan out the count after a left paren.
225 -- In the non-wide version we used Integer_IO.Get, but
226 -- that is not convenient here, since we don't want to
227 -- drag in normal Text_IO just for this purpose. So we
228 -- do the scan ourselves, with the normal validity checks.
230 Last
:= Picture_Index
+ 1;
233 if Picture
(Last
) not in '0' .. '9' then
237 Count
:= Character'Pos (Picture
(Last
)) - Character'Pos ('0');
241 if Last
> Picture
'Last then
245 if Picture
(Last
) = '_' then
246 if Picture
(Last
- 1) = '_' then
250 elsif Picture
(Last
) = ')' then
253 elsif Picture
(Last
) not in '0' .. '9' then
258 + Character'Pos (Picture
(Last
)) -
265 -- In what follows note that one copy of the repeated
266 -- character has already been made, so a count of one is a
267 -- no-op, and a count of zero erases a character.
269 for J
in 2 .. Count
loop
270 Result
(Result_Index
+ J
- 2) := Picture
(Picture_Index
- 1);
273 Result_Index
:= Result_Index
+ Count
- 1;
275 -- Last was a ')' throw it away too.
277 Picture_Index
:= Last
+ 1;
283 Result
(Result_Index
) := Picture
(Picture_Index
);
284 Picture_Index
:= Picture_Index
+ 1;
285 Result_Index
:= Result_Index
+ 1;
289 exit when Picture_Index
> Picture
'Last;
292 return Result
(1 .. Result_Index
- 1);
304 function Format_Number
305 (Pic
: Format_Record
;
307 Currency_Symbol
: Wide_String;
308 Fill_Character
: Wide_Character;
309 Separator_Character
: Wide_Character;
310 Radix_Point
: Wide_Character)
313 Attrs
: Number_Attributes
:= Parse_Number_String
(Number
);
315 Rounded
: String := Number
;
317 Sign_Position
: Integer := Pic
.Sign_Position
; -- may float.
319 Answer
: Wide_String (1 .. Pic
.Picture
.Length
);
321 Currency_Pos
: Integer := Pic
.Start_Currency
;
323 Dollar
: Boolean := False;
324 -- Overridden immediately if necessary.
326 Zero
: Boolean := True;
327 -- Set to False when a non-zero digit is output.
331 -- If the picture has fewer decimal places than the number, the image
332 -- must be rounded according to the usual rules.
334 if Attrs
.Has_Fraction
then
336 R
: constant Integer :=
337 (Attrs
.End_Of_Fraction
- Attrs
.Start_Of_Fraction
+ 1)
338 - Pic
.Max_Trailing_Digits
;
343 R_Pos
:= Rounded
'Length - R
;
345 if Rounded
(R_Pos
+ 1) > '4' then
347 if Rounded
(R_Pos
) = '.' then
351 if Rounded
(R_Pos
) /= '9' then
352 Rounded
(R_Pos
) := Character'Succ (Rounded
(R_Pos
));
354 Rounded
(R_Pos
) := '0';
358 if Rounded
(R_Pos
) = '.' then
362 if Rounded
(R_Pos
) /= '9' then
363 Rounded
(R_Pos
) := Character'Succ (Rounded
(R_Pos
));
366 Rounded
(R_Pos
) := '0';
371 -- The rounding may add a digit in front. Either the
372 -- leading blank or the sign (already captured) can
376 Rounded
(R_Pos
) := '1';
377 Attrs
.Start_Of_Int
:= Attrs
.Start_Of_Int
- 1;
385 for J
in Answer
'Range loop
386 Answer
(J
) := To_Wide
(Pic
.Picture
.Expanded
(J
));
389 if Pic
.Start_Currency
/= Invalid_Position
then
390 Dollar
:= Answer
(Pic
.Start_Currency
) = '$';
393 -- Fix up "direct inserts" outside the playing field. Set up as one
394 -- loop to do the beginning, one (reverse) loop to do the end.
398 exit when Last
= Pic
.Start_Float
;
399 exit when Last
= Pic
.Radix_Position
;
400 exit when Answer
(Last
) = '9';
402 case Answer
(Last
) is
405 Answer
(Last
) := Separator_Character
;
408 Answer
(Last
) := ' ';
415 exit when Last
= Answer
'Last;
420 -- Now for the end...
422 for J
in reverse Last
.. Answer
'Last loop
423 exit when J
= Pic
.Radix_Position
;
425 -- Do this test First, Separator_Character can equal Pic.Floater.
427 if Answer
(J
) = Pic
.Floater
then
434 Answer
(J
) := Separator_Character
;
450 if Pic
.Start_Currency
/= -1
451 and then Answer
(Pic
.Start_Currency
) = '#'
452 and then Pic
.Floater
/= '#'
454 if Currency_Symbol
'Length >
455 Pic
.End_Currency
- Pic
.Start_Currency
+ 1
459 elsif Currency_Symbol
'Length =
460 Pic
.End_Currency
- Pic
.Start_Currency
+ 1
462 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
465 elsif Pic
.Radix_Position
= Invalid_Position
466 or else Pic
.Start_Currency
< Pic
.Radix_Position
468 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
470 Answer
(Pic
.End_Currency
- Currency_Symbol
'Length + 1 ..
471 Pic
.End_Currency
) := Currency_Symbol
;
474 Answer
(Pic
.Start_Currency
.. Pic
.End_Currency
) :=
476 Answer
(Pic
.Start_Currency
..
477 Pic
.Start_Currency
+ Currency_Symbol
'Length - 1) :=
482 -- Fill in leading digits
484 if Attrs
.End_Of_Int
- Attrs
.Start_Of_Int
+ 1 >
485 Pic
.Max_Leading_Digits
490 if Pic
.Radix_Position
= Invalid_Position
then
491 Position
:= Answer
'Last;
493 Position
:= Pic
.Radix_Position
- 1;
496 for J
in reverse Attrs
.Start_Of_Int
.. Attrs
.End_Of_Int
loop
498 while Answer
(Position
) /= '9'
499 and Answer
(Position
) /= Pic
.Floater
501 if Answer
(Position
) = '_' then
502 Answer
(Position
) := Separator_Character
;
504 elsif Answer
(Position
) = 'b' then
505 Answer
(Position
) := ' ';
508 Position
:= Position
- 1;
511 Answer
(Position
) := To_Wide
(Rounded
(J
));
513 if Rounded
(J
) /= '0' then
517 Position
:= Position
- 1;
522 if Pic
.Start_Float
= Invalid_Position
then
524 -- No leading floats, but need to change '9' to '0', '_' to
525 -- Separator_Character and 'b' to ' '.
527 for J
in Last
.. Position
loop
529 -- Last set when fixing the "uninteresting" leaders above.
530 -- Don't duplicate the work.
532 if Answer
(J
) = '9' then
535 elsif Answer
(J
) = '_' then
536 Answer
(J
) := Separator_Character
;
538 elsif Answer
(J
) = 'b' then
545 elsif Pic
.Floater
= '<'
551 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
552 if Answer
(J
) = '9' then
555 elsif Answer
(J
) = '_' then
556 Answer
(J
) := Separator_Character
;
558 elsif Answer
(J
) = 'b' then
564 if Position
> Pic
.End_Float
then
565 Position
:= Pic
.End_Float
;
568 for J
in Pic
.Start_Float
.. Position
- 1 loop
572 Answer
(Position
) := Pic
.Floater
;
573 Sign_Position
:= Position
;
575 elsif Pic
.Floater
= '$' then
577 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
578 if Answer
(J
) = '9' then
581 elsif Answer
(J
) = '_' then
582 Answer
(J
) := ' '; -- no separator before leftmost digit.
584 elsif Answer
(J
) = 'b' then
589 if Position
> Pic
.End_Float
then
590 Position
:= Pic
.End_Float
;
593 for J
in Pic
.Start_Float
.. Position
- 1 loop
597 Answer
(Position
) := Pic
.Floater
;
598 Currency_Pos
:= Position
;
600 elsif Pic
.Floater
= '*' then
602 for J
in Pic
.End_Float
.. Position
loop -- May be null range.
603 if Answer
(J
) = '9' then
606 elsif Answer
(J
) = '_' then
607 Answer
(J
) := Separator_Character
;
609 elsif Answer
(J
) = 'b' then
614 if Position
> Pic
.End_Float
then
615 Position
:= Pic
.End_Float
;
618 for J
in Pic
.Start_Float
.. Position
loop
623 if Pic
.Floater
= '#' then
624 Currency_Pos
:= Currency_Symbol
'Length;
627 for J
in reverse Pic
.Start_Float
.. Position
loop
631 Answer
(J
) := Fill_Character
;
633 when 'Z' |
'b' |
'/' |
'0' =>
639 when '.' |
'V' |
'v' |
'<' |
'$' |
'+' |
'-' =>
643 if Currency_Pos
= 0 then
646 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
647 Currency_Pos
:= Currency_Pos
- 1;
655 Answer
(J
) := Fill_Character
;
661 if Currency_Pos
= 0 then
665 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
666 Currency_Pos
:= Currency_Pos
- 1;
680 if Pic
.Floater
= '#' and then Currency_Pos
/= 0 then
687 if Sign_Position
= Invalid_Position
then
688 if Attrs
.Negative
then
693 if Attrs
.Negative
then
694 case Answer
(Sign_Position
) is
695 when 'C' |
'D' |
'-' =>
699 Answer
(Sign_Position
) := '-';
702 Answer
(Sign_Position
) := '(';
703 Answer
(Pic
.Second_Sign
) := ')';
712 case Answer
(Sign_Position
) is
715 Answer
(Sign_Position
) := ' ';
717 when '<' |
'C' |
'D' =>
718 Answer
(Sign_Position
) := ' ';
719 Answer
(Pic
.Second_Sign
) := ' ';
731 -- Fill in trailing digits
733 if Pic
.Max_Trailing_Digits
> 0 then
735 if Attrs
.Has_Fraction
then
736 Position
:= Attrs
.Start_Of_Fraction
;
737 Last
:= Pic
.Radix_Position
+ 1;
739 for J
in Last
.. Answer
'Last loop
741 if Answer
(J
) = '9' or Answer
(J
) = Pic
.Floater
then
742 Answer
(J
) := To_Wide
(Rounded
(Position
));
744 if Rounded
(Position
) /= '0' then
748 Position
:= Position
+ 1;
751 -- Used up fraction but remember place in Answer
753 exit when Position
> Attrs
.End_Of_Fraction
;
755 elsif Answer
(J
) = 'b' then
758 elsif Answer
(J
) = '_' then
759 Answer
(J
) := Separator_Character
;
769 Position
:= Pic
.Radix_Position
+ 1;
772 -- Now fill remaining 9's with zeros and _ with separators
776 for J
in Position
.. Last
loop
777 if Answer
(J
) = '9' then
780 elsif Answer
(J
) = Pic
.Floater
then
783 elsif Answer
(J
) = '_' then
784 Answer
(J
) := Separator_Character
;
786 elsif Answer
(J
) = 'b' then
792 Position
:= Last
+ 1;
795 if Pic
.Floater
= '#' and then Currency_Pos
/= 0 then
799 -- No trailing digits, but now J may need to stick in a currency
802 if Pic
.Start_Currency
= Invalid_Position
then
803 Position
:= Answer
'Last + 1;
805 Position
:= Pic
.Start_Currency
;
809 for J
in Position
.. Answer
'Last loop
811 if Pic
.Start_Currency
/= Invalid_Position
and then
812 Answer
(Pic
.Start_Currency
) = '#' then
816 -- Note: There are some weird cases J can imagine with 'b' or '#'
817 -- in currency strings where the following code will cause
818 -- glitches. The trick is to tell when the character in the
819 -- answer should be checked, and when to look at the original
820 -- string. Some other time. RIE 11/26/96 ???
824 Answer
(J
) := Fill_Character
;
830 if Currency_Pos
> Currency_Symbol
'Length then
834 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
835 Currency_Pos
:= Currency_Pos
+ 1;
843 Answer
(J
) := Fill_Character
;
849 if Currency_Pos
> Currency_Symbol
'Length then
852 Answer
(J
) := Currency_Symbol
(Currency_Pos
);
853 Currency_Pos
:= Currency_Pos
+ 1;
867 -- Now get rid of Blank_when_Zero and complete Star fill.
869 if Zero
and Pic
.Blank_When_Zero
then
871 -- Value is zero, and blank it.
876 Last
:= Last
- 1 + Currency_Symbol
'Length;
879 if Pic
.Radix_Position
/= Invalid_Position
and then
880 Answer
(Pic
.Radix_Position
) = 'V' then
884 return Wide_String'(1 .. Last => ' ');
886 elsif Zero and Pic.Star_Fill then
890 Last := Last - 1 + Currency_Symbol'Length;
893 if Pic.Radix_Position /= Invalid_Position then
895 if Answer (Pic.Radix_Position) = 'V
' then
899 if Pic.Radix_Position > Pic.Start_Currency then
900 return Wide_String' (1 .. Pic
.Radix_Position
- 1 => '*') &
902 Wide_String' (Pic.Radix_Position + 1 .. Last => '*');
908 Pic
.Radix_Position
+ Currency_Symbol
'Length - 2
912 (Pic.Radix_Position + Currency_Symbol'Length .. Last
918 Wide_String'(1 .. Pic
.Radix_Position
- 1 => '*') &
920 Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
924 return Wide_String' (1 .. Last
=> '*');
927 -- This was once a simple return statement, now there are nine
928 -- different return cases. Not to mention the five above to deal
929 -- with zeros. Why not split things out?
931 -- Processing the radix and sign expansion separately
932 -- would require lots of copying--the string and some of its
933 -- indices--without really simplifying the logic. The cases are:
935 -- 1) Expand $, replace '.' with Radix_Point
936 -- 2) No currency expansion, replace '.' with Radix_Point
937 -- 3) Expand $, radix blanked
938 -- 4) No currency expansion, radix blanked
940 -- 6) Expand $, Elide V
941 -- 7) Elide V, Expand $ (Two cases depending on order.)
942 -- 8) No radix, expand $
943 -- 9) No radix, no currency expansion
945 if Pic
.Radix_Position
/= Invalid_Position
then
947 if Answer
(Pic
.Radix_Position
) = '.' then
948 Answer
(Pic
.Radix_Position
) := Radix_Point
;
952 -- 1) Expand $, replace '.' with Radix_Point
954 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
955 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
958 -- 2) No currency expansion, replace '.' with Radix_Point
963 elsif Answer
(Pic
.Radix_Position
) = ' ' then -- blanked radix.
966 -- 3) Expand $, radix blanked
968 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
969 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
972 -- 4) No expansion, radix blanked
984 return Answer
(1 .. Pic
.Radix_Position
- 1) &
985 Answer
(Pic
.Radix_Position
+ 1 .. Answer
'Last);
987 elsif Currency_Pos
< Pic
.Radix_Position
then
989 -- 6) Expand $, Elide V
991 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
992 Answer
(Currency_Pos
+ 1 .. Pic
.Radix_Position
- 1) &
993 Answer
(Pic
.Radix_Position
+ 1 .. Answer
'Last);
996 -- 7) Elide V, Expand $
998 return Answer
(1 .. Pic
.Radix_Position
- 1) &
999 Answer
(Pic
.Radix_Position
+ 1 .. Currency_Pos
- 1) &
1001 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
1007 -- 8) No radix, expand $
1009 return Answer
(1 .. Currency_Pos
- 1) & Currency_Symbol
&
1010 Answer
(Currency_Pos
+ 1 .. Answer
'Last);
1013 -- 9) No radix, no currency expansion
1020 -------------------------
1021 -- Parse_Number_String --
1022 -------------------------
1024 function Parse_Number_String
(Str
: String) return Number_Attributes
is
1025 Answer
: Number_Attributes
;
1028 for J
in Str
'Range loop
1036 -- Decide if this is the start of a number.
1037 -- If so, figure out which one...
1039 if Answer
.Has_Fraction
then
1040 Answer
.End_Of_Fraction
:= J
;
1042 if Answer
.Start_Of_Int
= Invalid_Position
then
1044 Answer
.Start_Of_Int
:= J
;
1046 Answer
.End_Of_Int
:= J
;
1051 -- Only count a zero before the decimal point if it follows a
1052 -- non-zero digit. After the decimal point, zeros will be
1053 -- counted if followed by a non-zero digit.
1055 if not Answer
.Has_Fraction
then
1056 if Answer
.Start_Of_Int
/= Invalid_Position
then
1057 Answer
.End_Of_Int
:= J
;
1065 Answer
.Negative
:= True;
1069 -- Close integer, start fraction
1071 if Answer
.Has_Fraction
then
1072 raise Picture_Error
;
1075 -- Two decimal points is a no-no.
1077 Answer
.Has_Fraction
:= True;
1078 Answer
.End_Of_Fraction
:= J
;
1080 -- Could leave this at Invalid_Position, but this seems the
1081 -- right way to indicate a null range...
1083 Answer
.Start_Of_Fraction
:= J
+ 1;
1084 Answer
.End_Of_Int
:= J
- 1;
1087 raise Picture_Error
; -- can this happen? probably not!
1091 if Answer
.Start_Of_Int
= Invalid_Position
then
1092 Answer
.Start_Of_Int
:= Answer
.End_Of_Int
+ 1;
1095 -- No significant (intger) digits needs a null range.
1099 end Parse_Number_String
;
1105 -- The following ensures that we return B and not b being careful not
1106 -- to break things which expect lower case b for blank. See CXF3A02.
1108 function Pic_String
(Pic
: in Picture
) return String is
1109 Temp
: String (1 .. Pic
.Contents
.Picture
.Length
) :=
1110 Pic
.Contents
.Picture
.Expanded
;
1112 for J
in Temp
'Range loop
1113 if Temp
(J
) = 'b' then Temp
(J
) := 'B'; end if;
1123 procedure Precalculate
(Pic
: in out Format_Record
) is
1125 Computed_BWZ
: Boolean := True;
1127 type Legality
is (Okay
, Reject
);
1128 State
: Legality
:= Reject
;
1129 -- Start in reject, which will reject null strings.
1131 Index
: Pic_Index
:= Pic
.Picture
.Expanded
'First;
1133 function At_End
return Boolean;
1134 pragma Inline
(At_End
);
1136 procedure Set_State
(L
: Legality
);
1137 pragma Inline
(Set_State
);
1139 function Look
return Character;
1140 pragma Inline
(Look
);
1142 function Is_Insert
return Boolean;
1143 pragma Inline
(Is_Insert
);
1146 pragma Inline
(Skip
);
1148 procedure Trailing_Currency
;
1149 procedure Trailing_Bracket
;
1150 procedure Number_Fraction
;
1151 procedure Number_Completion
;
1152 procedure Number_Fraction_Or_Bracket
;
1153 procedure Number_Fraction_Or_Z_Fill
;
1154 procedure Zero_Suppression
;
1155 procedure Floating_Bracket
;
1156 procedure Number_Fraction_Or_Star_Fill
;
1157 procedure Star_Suppression
;
1158 procedure Number_Fraction_Or_Dollar
;
1159 procedure Leading_Dollar
;
1160 procedure Number_Fraction_Or_Pound
;
1161 procedure Leading_Pound
;
1163 procedure Floating_Plus
;
1164 procedure Floating_Minus
;
1165 procedure Picture_Plus
;
1166 procedure Picture_Minus
;
1167 procedure Picture_Bracket
;
1169 procedure Optional_RHS_Sign
;
1170 procedure Picture_String
;
1176 function At_End
return Boolean is
1178 return Index
> Pic
.Picture
.Length
;
1181 ----------------------
1182 -- Floating_Bracket --
1183 ----------------------
1185 -- Note that Floating_Bracket is only called with an acceptable
1186 -- prefix. But we don't set Okay, because we must end with a '>'.
1188 procedure Floating_Bracket
is
1191 Pic
.End_Float
:= Index
;
1192 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1194 -- First bracket wasn't counted...
1205 when '_' |
'0' |
'/' =>
1206 Pic
.End_Float
:= Index
;
1210 Pic
.End_Float
:= Index
;
1211 Pic
.Picture
.Expanded
(Index
) := 'b';
1215 Pic
.End_Float
:= Index
;
1216 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1228 when 'V' |
'v' |
'.' =>
1229 Pic
.Radix_Position
:= Index
;
1231 Number_Fraction_Or_Bracket
;
1238 end Floating_Bracket
;
1240 --------------------
1241 -- Floating_Minus --
1242 --------------------
1244 procedure Floating_Minus
is
1252 when '_' |
'0' |
'/' =>
1253 Pic
.End_Float
:= Index
;
1257 Pic
.End_Float
:= Index
;
1258 Pic
.Picture
.Expanded
(Index
) := 'b';
1262 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1263 Pic
.End_Float
:= Index
;
1270 when '.' |
'V' |
'v' =>
1271 Pic
.Radix_Position
:= Index
;
1274 while Is_Insert
loop
1291 Pic
.Max_Trailing_Digits
:=
1292 Pic
.Max_Trailing_Digits
+ 1;
1293 Pic
.End_Float
:= Index
;
1296 when '_' |
'0' |
'/' =>
1300 Pic
.Picture
.Expanded
(Index
) := 'b';
1325 procedure Floating_Plus
is
1333 when '_' |
'0' |
'/' =>
1334 Pic
.End_Float
:= Index
;
1338 Pic
.End_Float
:= Index
;
1339 Pic
.Picture
.Expanded
(Index
) := 'b';
1343 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1344 Pic
.End_Float
:= Index
;
1351 when '.' |
'V' |
'v' =>
1352 Pic
.Radix_Position
:= Index
;
1355 while Is_Insert
loop
1372 Pic
.Max_Trailing_Digits
:=
1373 Pic
.Max_Trailing_Digits
+ 1;
1374 Pic
.End_Float
:= Index
;
1377 when '_' |
'0' |
'/' =>
1381 Pic
.Picture
.Expanded
(Index
) := 'b';
1407 function Is_Insert
return Boolean is
1413 case Pic
.Picture
.Expanded
(Index
) is
1415 when '_' |
'0' |
'/' => return True;
1418 Pic
.Picture
.Expanded
(Index
) := 'b'; -- canonical
1421 when others => return False;
1425 --------------------
1426 -- Leading_Dollar --
1427 --------------------
1429 -- Note that Leading_Dollar can be called in either State.
1430 -- It will set state to Okay only if a 9 or (second) $
1433 -- Also notice the tricky bit with State and Zero_Suppression.
1434 -- Zero_Suppression is Picture_Error if a '$' or a '9' has been
1435 -- encountered, exactly the cases where State has been set.
1437 procedure Leading_Dollar
is
1439 -- Treat as a floating dollar, and unwind otherwise.
1442 Pic
.Start_Currency
:= Index
;
1443 Pic
.End_Currency
:= Index
;
1444 Pic
.Start_Float
:= Index
;
1445 Pic
.End_Float
:= Index
;
1447 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1459 when '_' |
'0' |
'/' =>
1460 Pic
.End_Float
:= Index
;
1463 -- A trailing insertion character is not part of the
1464 -- floating currency, so need to look ahead.
1467 Pic
.End_Float
:= Pic
.End_Float
- 1;
1471 Pic
.End_Float
:= Index
;
1472 Pic
.Picture
.Expanded
(Index
) := 'b';
1476 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1478 if State
= Okay
then
1479 raise Picture_Error
;
1481 -- Will overwrite Floater and Start_Float
1487 if State
= Okay
then
1488 raise Picture_Error
;
1490 -- Will overwrite Floater and Start_Float
1496 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1497 Pic
.End_Float
:= Index
;
1498 Pic
.End_Currency
:= Index
;
1499 Set_State
(Okay
); Skip
;
1502 if State
/= Okay
then
1504 Pic
.Start_Float
:= Invalid_Position
;
1505 Pic
.End_Float
:= Invalid_Position
;
1508 -- A single dollar does not a floating make.
1513 when 'V' |
'v' |
'.' =>
1514 if State
/= Okay
then
1516 Pic
.Start_Float
:= Invalid_Position
;
1517 Pic
.End_Float
:= Invalid_Position
;
1520 -- Only one dollar before the sign is okay,
1521 -- but doesn't float.
1523 Pic
.Radix_Position
:= Index
;
1525 Number_Fraction_Or_Dollar
;
1539 -- This one is complex! A Leading_Pound can be fixed or floating,
1540 -- but in some cases the decision has to be deferred until we leave
1541 -- this procedure. Also note that Leading_Pound can be called in
1544 -- It will set state to Okay only if a 9 or (second) # is
1547 -- One Last note: In ambiguous cases, the currency is treated as
1548 -- floating unless there is only one '#'.
1550 procedure Leading_Pound
is
1552 Inserts
: Boolean := False;
1553 -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1555 Must_Float
: Boolean := False;
1556 -- Set to true if a '#' occurs after an insert.
1559 -- Treat as a floating currency. If it isn't, this will be
1560 -- overwritten later.
1564 Pic
.Start_Currency
:= Index
;
1565 Pic
.End_Currency
:= Index
;
1566 Pic
.Start_Float
:= Index
;
1567 Pic
.End_Float
:= Index
;
1569 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
1572 Pic
.Max_Currency_Digits
:= 1; -- we've seen one.
1583 when '_' |
'0' |
'/' =>
1584 Pic
.End_Float
:= Index
;
1589 Pic
.Picture
.Expanded
(Index
) := 'b';
1590 Pic
.End_Float
:= Index
;
1595 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
1598 raise Picture_Error
;
1600 Pic
.Max_Leading_Digits
:= 0;
1602 -- Will overwrite Floater and Start_Float
1609 raise Picture_Error
;
1611 Pic
.Max_Leading_Digits
:= 0;
1613 -- Will overwrite Floater and Start_Float
1623 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1624 Pic
.End_Float
:= Index
;
1625 Pic
.End_Currency
:= Index
;
1630 if State
/= Okay
then
1632 -- A single '#' doesn't float.
1635 Pic
.Start_Float
:= Invalid_Position
;
1636 Pic
.End_Float
:= Invalid_Position
;
1642 when 'V' |
'v' |
'.' =>
1643 if State
/= Okay
then
1645 Pic
.Start_Float
:= Invalid_Position
;
1646 Pic
.End_Float
:= Invalid_Position
;
1649 -- Only one pound before the sign is okay,
1650 -- but doesn't float.
1652 Pic
.Radix_Position
:= Index
;
1654 Number_Fraction_Or_Pound
;
1667 function Look
return Character is
1670 raise Picture_Error
;
1673 return Pic
.Picture
.Expanded
(Index
);
1685 when '_' |
'0' |
'/' =>
1689 Pic
.Picture
.Expanded
(Index
) := 'b';
1693 Computed_BWZ
:= False;
1694 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1698 when '.' |
'V' |
'v' =>
1699 Pic
.Radix_Position
:= Index
;
1713 -- Will return in Okay state if a '9' was seen.
1718 -----------------------
1719 -- Number_Completion --
1720 -----------------------
1722 procedure Number_Completion
is
1724 while not At_End
loop
1727 when '_' |
'0' |
'/' =>
1731 Pic
.Picture
.Expanded
(Index
) := 'b';
1735 Computed_BWZ
:= False;
1736 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
1740 when 'V' |
'v' |
'.' =>
1741 Pic
.Radix_Position
:= Index
;
1750 end Number_Completion
;
1752 ---------------------
1753 -- Number_Fraction --
1754 ---------------------
1756 procedure Number_Fraction
is
1758 -- Note that number fraction can be called in either State.
1759 -- It will set state to Valid only if a 9 is encountered.
1767 when '_' |
'0' |
'/' =>
1771 Pic
.Picture
.Expanded
(Index
) := 'b';
1775 Computed_BWZ
:= False;
1776 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1777 Set_State
(Okay
); Skip
;
1783 end Number_Fraction
;
1785 --------------------------------
1786 -- Number_Fraction_Or_Bracket --
1787 --------------------------------
1789 procedure Number_Fraction_Or_Bracket
is
1798 when '_' |
'0' |
'/' => Skip
;
1801 Pic
.Picture
.Expanded
(Index
) := 'b';
1805 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1806 Pic
.End_Float
:= Index
;
1815 when '_' |
'0' |
'/' =>
1819 Pic
.Picture
.Expanded
(Index
) := 'b';
1823 Pic
.Max_Trailing_Digits
:=
1824 Pic
.Max_Trailing_Digits
+ 1;
1825 Pic
.End_Float
:= Index
;
1838 end Number_Fraction_Or_Bracket
;
1840 -------------------------------
1841 -- Number_Fraction_Or_Dollar --
1842 -------------------------------
1844 procedure Number_Fraction_Or_Dollar
is
1852 when '_' |
'0' |
'/' =>
1856 Pic
.Picture
.Expanded
(Index
) := 'b';
1860 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1861 Pic
.End_Float
:= Index
;
1870 when '_' |
'0' |
'/' =>
1874 Pic
.Picture
.Expanded
(Index
) := 'b';
1878 Pic
.Max_Trailing_Digits
:=
1879 Pic
.Max_Trailing_Digits
+ 1;
1880 Pic
.End_Float
:= Index
;
1893 end Number_Fraction_Or_Dollar
;
1895 ------------------------------
1896 -- Number_Fraction_Or_Pound --
1897 ------------------------------
1899 procedure Number_Fraction_Or_Pound
is
1908 when '_' |
'0' |
'/' =>
1912 Pic
.Picture
.Expanded
(Index
) := 'b';
1916 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1917 Pic
.End_Float
:= Index
;
1927 when '_' |
'0' |
'/' =>
1931 Pic
.Picture
.Expanded
(Index
) := 'b';
1935 Pic
.Max_Trailing_Digits
:=
1936 Pic
.Max_Trailing_Digits
+ 1;
1937 Pic
.End_Float
:= Index
;
1952 end Number_Fraction_Or_Pound
;
1954 ----------------------------------
1955 -- Number_Fraction_Or_Star_Fill --
1956 ----------------------------------
1958 procedure Number_Fraction_Or_Star_Fill
is
1967 when '_' |
'0' |
'/' =>
1971 Pic
.Picture
.Expanded
(Index
) := 'b';
1975 Pic
.Star_Fill
:= True;
1976 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
1977 Pic
.End_Float
:= Index
;
1987 when '_' |
'0' |
'/' =>
1991 Pic
.Picture
.Expanded
(Index
) := 'b';
1995 Pic
.Star_Fill
:= True;
1996 Pic
.Max_Trailing_Digits
:=
1997 Pic
.Max_Trailing_Digits
+ 1;
1998 Pic
.End_Float
:= Index
;
2012 end Number_Fraction_Or_Star_Fill
;
2014 -------------------------------
2015 -- Number_Fraction_Or_Z_Fill --
2016 -------------------------------
2018 procedure Number_Fraction_Or_Z_Fill
is
2027 when '_' |
'0' |
'/' =>
2031 Pic
.Picture
.Expanded
(Index
) := 'b';
2035 Pic
.Max_Trailing_Digits
:= Pic
.Max_Trailing_Digits
+ 1;
2036 Pic
.End_Float
:= Index
;
2037 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2048 when '_' |
'0' |
'/' =>
2052 Pic
.Picture
.Expanded
(Index
) := 'b';
2056 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2058 Pic
.Max_Trailing_Digits
:=
2059 Pic
.Max_Trailing_Digits
+ 1;
2060 Pic
.End_Float
:= Index
;
2073 end Number_Fraction_Or_Z_Fill
;
2075 -----------------------
2076 -- Optional_RHS_Sign --
2077 -----------------------
2079 procedure Optional_RHS_Sign
is
2088 Pic
.Sign_Position
:= Index
;
2093 Pic
.Sign_Position
:= Index
;
2094 Pic
.Picture
.Expanded
(Index
) := 'C';
2097 if Look
= 'R' or Look
= 'r' then
2098 Pic
.Second_Sign
:= Index
;
2099 Pic
.Picture
.Expanded
(Index
) := 'R';
2103 raise Picture_Error
;
2109 Pic
.Sign_Position
:= Index
;
2110 Pic
.Picture
.Expanded
(Index
) := 'D';
2113 if Look
= 'B' or Look
= 'b' then
2114 Pic
.Second_Sign
:= Index
;
2115 Pic
.Picture
.Expanded
(Index
) := 'B';
2119 raise Picture_Error
;
2125 if Pic
.Picture
.Expanded
(Pic
.Sign_Position
) = '<' then
2126 Pic
.Second_Sign
:= Index
;
2130 raise Picture_Error
;
2137 end Optional_RHS_Sign
;
2143 -- Note that Picture can be called in either State.
2145 -- It will set state to Valid only if a 9 is encountered or floating
2146 -- currency is called.
2148 procedure Picture
is
2157 when '_' |
'0' |
'/' =>
2161 Pic
.Picture
.Expanded
(Index
) := 'b';
2173 Computed_BWZ
:= False;
2175 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2178 when 'V' |
'v' |
'.' =>
2179 Pic
.Radix_Position
:= Index
;
2192 ---------------------
2193 -- Picture_Bracket --
2194 ---------------------
2196 procedure Picture_Bracket
is
2198 Pic
.Sign_Position
:= Index
;
2199 Pic
.Sign_Position
:= Index
;
2201 -- Treat as a floating sign, and unwind otherwise.
2204 Pic
.Start_Float
:= Index
;
2205 Pic
.End_Float
:= Index
;
2207 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2210 Skip
; -- Known Bracket
2215 when '_' |
'0' |
'/' =>
2216 Pic
.End_Float
:= Index
;
2220 Pic
.End_Float
:= Index
;
2221 Pic
.Picture
.Expanded
(Index
) := 'b';
2225 Set_State
(Okay
); -- "<<>" is enough.
2231 when '$' |
'#' |
'9' |
'*' =>
2232 if State
/= Okay
then
2234 Pic
.Start_Float
:= Invalid_Position
;
2235 Pic
.End_Float
:= Invalid_Position
;
2243 when '.' |
'V' |
'v' =>
2244 if State
/= Okay
then
2246 Pic
.Start_Float
:= Invalid_Position
;
2247 Pic
.End_Float
:= Invalid_Position
;
2250 -- Don't assume that state is okay, haven't seen a digit
2257 raise Picture_Error
;
2261 end Picture_Bracket
;
2267 procedure Picture_Minus
is
2269 Pic
.Sign_Position
:= Index
;
2271 -- Treat as a floating sign, and unwind otherwise.
2274 Pic
.Start_Float
:= Index
;
2275 Pic
.End_Float
:= Index
;
2277 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2280 Skip
; -- Known Minus
2285 when '_' |
'0' |
'/' =>
2286 Pic
.End_Float
:= Index
;
2290 Pic
.End_Float
:= Index
;
2291 Pic
.Picture
.Expanded
(Index
) := 'b';
2295 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2296 Pic
.End_Float
:= Index
;
2298 Set_State
(Okay
); -- "-- " is enough.
2303 when '$' |
'#' |
'9' |
'*' =>
2304 if State
/= Okay
then
2306 Pic
.Start_Float
:= Invalid_Position
;
2307 Pic
.End_Float
:= Invalid_Position
;
2316 -- Can't have Z and a floating sign.
2318 if State
= Okay
then
2322 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2328 when '.' |
'V' |
'v' =>
2329 if State
/= Okay
then
2331 Pic
.Start_Float
:= Invalid_Position
;
2332 Pic
.End_Float
:= Invalid_Position
;
2335 -- Don't assume that state is okay, haven't seen a digit.
2351 procedure Picture_Plus
is
2353 Pic
.Sign_Position
:= Index
;
2355 -- Treat as a floating sign, and unwind otherwise.
2358 Pic
.Start_Float
:= Index
;
2359 Pic
.End_Float
:= Index
;
2361 -- Don't increment Pic.Max_Leading_Digits, we need one "real"
2369 when '_' |
'0' |
'/' =>
2370 Pic
.End_Float
:= Index
;
2374 Pic
.End_Float
:= Index
;
2375 Pic
.Picture
.Expanded
(Index
) := 'b';
2379 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2380 Pic
.End_Float
:= Index
;
2382 Set_State
(Okay
); -- "++" is enough.
2387 when '$' |
'#' |
'9' |
'*' =>
2388 if State
/= Okay
then
2390 Pic
.Start_Float
:= Invalid_Position
;
2391 Pic
.End_Float
:= Invalid_Position
;
2399 if State
= Okay
then
2403 -- Can't have Z and a floating sign.
2405 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2407 -- '+Z' is acceptable
2416 when '.' |
'V' |
'v' =>
2417 if State
/= Okay
then
2419 Pic
.Start_Float
:= Invalid_Position
;
2420 Pic
.End_Float
:= Invalid_Position
;
2423 -- Don't assume that state is okay, haven't seen a digit.
2435 --------------------
2436 -- Picture_String --
2437 --------------------
2439 procedure Picture_String
is
2441 while Is_Insert
loop
2461 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2471 when '9' |
'.' |
'V' |
'v' =>
2477 raise Picture_Error
;
2481 -- Blank when zero either if the PIC does not contain a '9' or if
2482 -- requested by the user and no '*'
2484 Pic
.Blank_When_Zero
:=
2485 (Computed_BWZ
or Pic
.Blank_When_Zero
) and not Pic
.Star_Fill
;
2487 -- Star fill if '*' and no '9'.
2489 Pic
.Star_Fill
:= Pic
.Star_Fill
and Computed_BWZ
;
2501 procedure Set_State
(L
: Legality
) is
2515 ----------------------
2516 -- Star_Suppression --
2517 ----------------------
2519 procedure Star_Suppression
is
2522 Pic
.Start_Float
:= Index
;
2523 Pic
.End_Float
:= Index
;
2524 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2527 -- Even a single * is a valid picture
2529 Pic
.Star_Fill
:= True;
2539 when '_' |
'0' |
'/' =>
2540 Pic
.End_Float
:= Index
;
2544 Pic
.End_Float
:= Index
;
2545 Pic
.Picture
.Expanded
(Index
) := 'b';
2549 Pic
.End_Float
:= Index
;
2550 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2551 Set_State
(Okay
); Skip
;
2558 when '.' |
'V' |
'v' =>
2559 Pic
.Radix_Position
:= Index
;
2561 Number_Fraction_Or_Star_Fill
;
2569 when others => raise Picture_Error
;
2572 end Star_Suppression
;
2574 ----------------------
2575 -- Trailing_Bracket --
2576 ----------------------
2578 procedure Trailing_Bracket
is
2581 Pic
.Second_Sign
:= Index
;
2584 raise Picture_Error
;
2586 end Trailing_Bracket
;
2588 -----------------------
2589 -- Trailing_Currency --
2590 -----------------------
2592 procedure Trailing_Currency
is
2599 Pic
.Start_Currency
:= Index
;
2600 Pic
.End_Currency
:= Index
;
2604 while not At_End
and then Look
= '#' loop
2605 if Pic
.Start_Currency
= Invalid_Position
then
2606 Pic
.Start_Currency
:= Index
;
2609 Pic
.End_Currency
:= Index
;
2620 when '_' |
'0' |
'/' => Skip
;
2623 Pic
.Picture
.Expanded
(Index
) := 'b';
2626 when others => return;
2629 end Trailing_Currency
;
2631 ----------------------
2632 -- Zero_Suppression --
2633 ----------------------
2635 procedure Zero_Suppression
is
2638 Pic
.Start_Float
:= Index
;
2639 Pic
.End_Float
:= Index
;
2640 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2641 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2646 -- Even a single Z is a valid picture
2654 when '_' |
'0' |
'/' =>
2655 Pic
.End_Float
:= Index
;
2659 Pic
.End_Float
:= Index
;
2660 Pic
.Picture
.Expanded
(Index
) := 'b';
2664 Pic
.Picture
.Expanded
(Index
) := 'Z'; -- consistency
2666 Pic
.Max_Leading_Digits
:= Pic
.Max_Leading_Digits
+ 1;
2667 Pic
.End_Float
:= Index
;
2676 when '.' |
'V' |
'v' =>
2677 Pic
.Radix_Position
:= Index
;
2679 Number_Fraction_Or_Z_Fill
;
2691 end Zero_Suppression
;
2693 -- Start of processing for Precalculate
2698 if State
= Reject
then
2699 raise Picture_Error
;
2704 when Constraint_Error
=>
2706 -- To deal with special cases like null strings.
2708 raise Picture_Error
;
2717 (Pic_String
: in String;
2718 Blank_When_Zero
: in Boolean := False)
2725 Item
: constant String := Expand
(Pic_String
);
2728 Result
.Contents
.Picture
:= (Item
'Length, Item
);
2729 Result
.Contents
.Original_BWZ
:= Blank_When_Zero
;
2730 Result
.Contents
.Blank_When_Zero
:= Blank_When_Zero
;
2731 Precalculate
(Result
.Contents
);
2737 raise Picture_Error
;
2745 function To_Wide
(C
: Character) return Wide_Character is
2747 return Wide_Character'Val (Character'Pos (C
));
2755 (Pic_String
: in String;
2756 Blank_When_Zero
: in Boolean := False)
2761 Expanded_Pic
: constant String := Expand
(Pic_String
);
2762 -- Raises Picture_Error if Item not well-formed
2764 Format_Rec
: Format_Record
;
2767 Format_Rec
.Picture
:= (Expanded_Pic
'Length, Expanded_Pic
);
2768 Format_Rec
.Blank_When_Zero
:= Blank_When_Zero
;
2769 Format_Rec
.Original_BWZ
:= Blank_When_Zero
;
2770 Precalculate
(Format_Rec
);
2772 -- False only if Blank_When_0 is True but the pic string
2775 return not Blank_When_Zero
or
2776 Strings_Fixed
.Index
(Expanded_Pic
, "*") = 0;
2780 when others => return False;
2784 end Ada
.Wide_Text_IO
.Editing
;