with Ada.Strings.Fixed;
with Ada.Strings.Wide_Fixed;
package body Ada.Wide_Text_IO.Editing is
package Strings renames Ada.Strings;
package Strings_Fixed renames Ada.Strings.Fixed;
package Strings_Wide_Fixed renames Ada.Strings.Wide_Fixed;
package Wide_Text_IO renames Ada.Wide_Text_IO;
function To_Wide (C : Character) return Wide_Character;
pragma Inline (To_Wide);
function Blank_When_Zero (Pic : in Picture) return Boolean is
begin
return Pic.Contents.Original_BWZ;
end Blank_When_Zero;
package body Decimal_Output is
function Image
(Item : Num;
Pic : Picture;
Currency : Wide_String := Default_Currency;
Fill : Wide_Character := Default_Fill;
Separator : Wide_Character := Default_Separator;
Radix_Mark : Wide_Character := Default_Radix_Mark) return Wide_String
is
begin
return Format_Number
(Pic.Contents, Num'Image (Item),
Currency, Fill, Separator, Radix_Mark);
end Image;
function Length
(Pic : Picture;
Currency : Wide_String := Default_Currency) return Natural
is
Picstr : constant String := Pic_String (Pic);
V_Adjust : Integer := 0;
Cur_Adjust : Integer := 0;
begin
for J in Picstr'Range loop
if Picstr (J) = 'V' then
V_Adjust := -1;
elsif Picstr (J) = '$' then
Cur_Adjust := Currency'Length - 1;
end if;
end loop;
return Picstr'Length - V_Adjust + Cur_Adjust;
end Length;
procedure Put
(File : Wide_Text_IO.File_Type;
Item : Num;
Pic : Picture;
Currency : Wide_String := Default_Currency;
Fill : Wide_Character := Default_Fill;
Separator : Wide_Character := Default_Separator;
Radix_Mark : Wide_Character := Default_Radix_Mark)
is
begin
Wide_Text_IO.Put (File, Image (Item, Pic,
Currency, Fill, Separator, Radix_Mark));
end Put;
procedure Put
(Item : Num;
Pic : Picture;
Currency : Wide_String := Default_Currency;
Fill : Wide_Character := Default_Fill;
Separator : Wide_Character := Default_Separator;
Radix_Mark : Wide_Character := Default_Radix_Mark)
is
begin
Wide_Text_IO.Put (Image (Item, Pic,
Currency, Fill, Separator, Radix_Mark));
end Put;
procedure Put
(To : out Wide_String;
Item : Num;
Pic : Picture;
Currency : Wide_String := Default_Currency;
Fill : Wide_Character := Default_Fill;
Separator : Wide_Character := Default_Separator;
Radix_Mark : Wide_Character := Default_Radix_Mark)
is
Result : constant Wide_String :=
Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
begin
if Result'Length > To'Length then
raise Wide_Text_IO.Layout_Error;
else
Strings_Wide_Fixed.Move (Source => Result, Target => To,
Justify => Strings.Right);
end if;
end Put;
function Valid
(Item : Num;
Pic : Picture;
Currency : Wide_String := Default_Currency) return Boolean
is
begin
declare
Temp : constant Wide_String := Image (Item, Pic, Currency);
pragma Warnings (Off, Temp);
begin
return True;
end;
exception
when Layout_Error => return False;
end Valid;
end Decimal_Output;
function Expand (Picture : in String) return String is
Result : String (1 .. MAX_PICSIZE);
Picture_Index : Integer := Picture'First;
Result_Index : Integer := Result'First;
Count : Natural;
Last : Integer;
begin
if Picture'Length < 1 then
raise Picture_Error;
end if;
if Picture (Picture'First) = '(' then
raise Picture_Error;
end if;
loop
case Picture (Picture_Index) is
when '(' =>
Last := Picture_Index + 1;
Count := 0;
if Picture (Last) not in '0' .. '9' then
raise Picture_Error;
end if;
Count := Character'Pos (Picture (Last)) - Character'Pos ('0');
Last := Last + 1;
loop
if Last > Picture'Last then
raise Picture_Error;
end if;
if Picture (Last) = '_' then
if Picture (Last - 1) = '_' then
raise Picture_Error;
end if;
elsif Picture (Last) = ')' then
exit;
elsif Picture (Last) not in '0' .. '9' then
raise Picture_Error;
else
Count := Count * 10
+ Character'Pos (Picture (Last)) -
Character'Pos ('0');
end if;
Last := Last + 1;
end loop;
for J in 2 .. Count loop
Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
end loop;
Result_Index := Result_Index + Count - 1;
Picture_Index := Last + 1;
when ')' =>
raise Picture_Error;
when others =>
Result (Result_Index) := Picture (Picture_Index);
Picture_Index := Picture_Index + 1;
Result_Index := Result_Index + 1;
end case;
exit when Picture_Index > Picture'Last;
end loop;
return Result (1 .. Result_Index - 1);
exception
when others =>
raise Picture_Error;
end Expand;
function Format_Number
(Pic : Format_Record;
Number : String;
Currency_Symbol : Wide_String;
Fill_Character : Wide_Character;
Separator_Character : Wide_Character;
Radix_Point : Wide_Character) return Wide_String
is
Attrs : Number_Attributes := Parse_Number_String (Number);
Position : Integer;
Rounded : String := Number;
Sign_Position : Integer := Pic.Sign_Position;
Answer : Wide_String (1 .. Pic.Picture.Length);
Last : Integer;
Currency_Pos : Integer := Pic.Start_Currency;
Dollar : Boolean := False;
Zero : Boolean := True;
begin
if Attrs.Has_Fraction then
declare
R : constant Integer :=
(Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
- Pic.Max_Trailing_Digits;
R_Pos : Integer;
begin
if R > 0 then
R_Pos := Rounded'Length - R;
if Rounded (R_Pos + 1) > '4' then
if Rounded (R_Pos) = '.' then
R_Pos := R_Pos - 1;
end if;
if Rounded (R_Pos) /= '9' then
Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
else
Rounded (R_Pos) := '0';
R_Pos := R_Pos - 1;
while R_Pos > 1 loop
if Rounded (R_Pos) = '.' then
R_Pos := R_Pos - 1;
end if;
if Rounded (R_Pos) /= '9' then
Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
exit;
else
Rounded (R_Pos) := '0';
R_Pos := R_Pos - 1;
end if;
end loop;
if R_Pos = 1 then
Rounded (R_Pos) := '1';
Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
end if;
end if;
end if;
end if;
end;
end if;
for J in Answer'Range loop
Answer (J) := To_Wide (Pic.Picture.Expanded (J));
end loop;
if Pic.Start_Currency /= Invalid_Position then
Dollar := Answer (Pic.Start_Currency) = '$';
end if;
Last := 1;
loop
exit when Last = Pic.Start_Float;
exit when Last = Pic.Radix_Position;
exit when Answer (Last) = '9';
case Answer (Last) is
when '_' =>
Answer (Last) := Separator_Character;
when 'b' =>
Answer (Last) := ' ';
when others =>
null;
end case;
exit when Last = Answer'Last;
Last := Last + 1;
end loop;
for J in reverse Last .. Answer'Last loop
exit when J = Pic.Radix_Position;
if Answer (J) = Pic.Floater then
exit;
end if;
case Answer (J) is
when '_' =>
Answer (J) := Separator_Character;
when 'b' =>
Answer (J) := ' ';
when '9' =>
exit;
when others =>
null;
end case;
end loop;
if Pic.Start_Currency /= -1
and then Answer (Pic.Start_Currency) = '#'
and then Pic.Floater /= '#'
then
if Currency_Symbol'Length >
Pic.End_Currency - Pic.Start_Currency + 1
then
raise Picture_Error;
elsif Currency_Symbol'Length =
Pic.End_Currency - Pic.Start_Currency + 1
then
Answer (Pic.Start_Currency .. Pic.End_Currency) :=
Currency_Symbol;
elsif Pic.Radix_Position = Invalid_Position
or else Pic.Start_Currency < Pic.Radix_Position
then
Answer (Pic.Start_Currency .. Pic.End_Currency) :=
(others => ' ');
Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
Pic.End_Currency) := Currency_Symbol;
else
Answer (Pic.Start_Currency .. Pic.End_Currency) :=
(others => ' ');
Answer (Pic.Start_Currency ..
Pic.Start_Currency + Currency_Symbol'Length - 1) :=
Currency_Symbol;
end if;
end if;
if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
Pic.Max_Leading_Digits
then
raise Layout_Error;
end if;
if Pic.Radix_Position = Invalid_Position then
Position := Answer'Last;
else
Position := Pic.Radix_Position - 1;
end if;
for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
while Answer (Position) /= '9'
and Answer (Position) /= Pic.Floater
loop
if Answer (Position) = '_' then
Answer (Position) := Separator_Character;
elsif Answer (Position) = 'b' then
Answer (Position) := ' ';
end if;
Position := Position - 1;
end loop;
Answer (Position) := To_Wide (Rounded (J));
if Rounded (J) /= '0' then
Zero := False;
end if;
Position := Position - 1;
end loop;
if Pic.Start_Float = Invalid_Position then
for J in Last .. Position loop
if Answer (J) = '9' then
Answer (J) := '0';
elsif Answer (J) = '_' then
Answer (J) := Separator_Character;
elsif Answer (J) = 'b' then
Answer (J) := ' ';
end if;
end loop;
elsif Pic.Floater = '<'
or else
Pic.Floater = '+'
or else
Pic.Floater = '-'
then
for J in Pic.End_Float .. Position loop if Answer (J) = '9' then
Answer (J) := '0';
elsif Answer (J) = '_' then
Answer (J) := Separator_Character;
elsif Answer (J) = 'b' then
Answer (J) := ' ';
end if;
end loop;
if Position > Pic.End_Float then
Position := Pic.End_Float;
end if;
for J in Pic.Start_Float .. Position - 1 loop
Answer (J) := ' ';
end loop;
Answer (Position) := Pic.Floater;
Sign_Position := Position;
elsif Pic.Floater = '$' then
for J in Pic.End_Float .. Position loop if Answer (J) = '9' then
Answer (J) := '0';
elsif Answer (J) = '_' then
Answer (J) := ' ';
elsif Answer (J) = 'b' then
Answer (J) := ' ';
end if;
end loop;
if Position > Pic.End_Float then
Position := Pic.End_Float;
end if;
for J in Pic.Start_Float .. Position - 1 loop
Answer (J) := ' ';
end loop;
Answer (Position) := Pic.Floater;
Currency_Pos := Position;
elsif Pic.Floater = '*' then
for J in Pic.End_Float .. Position loop if Answer (J) = '9' then
Answer (J) := '0';
elsif Answer (J) = '_' then
Answer (J) := Separator_Character;
elsif Answer (J) = 'b' then
Answer (J) := '*';
end if;
end loop;
if Position > Pic.End_Float then
Position := Pic.End_Float;
end if;
for J in Pic.Start_Float .. Position loop
Answer (J) := '*';
end loop;
else
if Pic.Floater = '#' then
Currency_Pos := Currency_Symbol'Length;
end if;
for J in reverse Pic.Start_Float .. Position loop
case Answer (J) is
when '*' =>
Answer (J) := Fill_Character;
when 'Z' | 'b' | '/' | '0' =>
Answer (J) := ' ';
when '9' =>
Answer (J) := '0';
when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
null;
when '#' =>
if Currency_Pos = 0 then
Answer (J) := ' ';
else
Answer (J) := Currency_Symbol (Currency_Pos);
Currency_Pos := Currency_Pos - 1;
end if;
when '_' =>
case Pic.Floater is
when '*' =>
Answer (J) := Fill_Character;
when 'Z' | 'b' =>
Answer (J) := ' ';
when '#' =>
if Currency_Pos = 0 then
Answer (J) := ' ';
else
Answer (J) := Currency_Symbol (Currency_Pos);
Currency_Pos := Currency_Pos - 1;
end if;
when others =>
null;
end case;
when others =>
null;
end case;
end loop;
if Pic.Floater = '#' and then Currency_Pos /= 0 then
raise Layout_Error;
end if;
end if;
if Sign_Position = Invalid_Position then
if Attrs.Negative then
raise Layout_Error;
end if;
else
if Attrs.Negative then
case Answer (Sign_Position) is
when 'C' | 'D' | '-' =>
null;
when '+' =>
Answer (Sign_Position) := '-';
when '<' =>
Answer (Sign_Position) := '(';
Answer (Pic.Second_Sign) := ')';
when others =>
raise Picture_Error;
end case;
else
case Answer (Sign_Position) is
when '-' =>
Answer (Sign_Position) := ' ';
when '<' | 'C' | 'D' =>
Answer (Sign_Position) := ' ';
Answer (Pic.Second_Sign) := ' ';
when '+' =>
null;
when others =>
raise Picture_Error;
end case;
end if;
end if;
if Pic.Max_Trailing_Digits > 0 then
if Attrs.Has_Fraction then
Position := Attrs.Start_Of_Fraction;
Last := Pic.Radix_Position + 1;
for J in Last .. Answer'Last loop
if Answer (J) = '9' or Answer (J) = Pic.Floater then
Answer (J) := To_Wide (Rounded (Position));
if Rounded (Position) /= '0' then
Zero := False;
end if;
Position := Position + 1;
Last := J + 1;
exit when Position > Attrs.End_Of_Fraction;
elsif Answer (J) = 'b' then
Answer (J) := ' ';
elsif Answer (J) = '_' then
Answer (J) := Separator_Character;
end if;
Last := J + 1;
end loop;
Position := Last;
else
Position := Pic.Radix_Position + 1;
end if;
Last := Answer'Last;
for J in Position .. Last loop
if Answer (J) = '9' then
Answer (J) := '0';
elsif Answer (J) = Pic.Floater then
Answer (J) := '0';
elsif Answer (J) = '_' then
Answer (J) := Separator_Character;
elsif Answer (J) = 'b' then
Answer (J) := ' ';
end if;
end loop;
Position := Last + 1;
else
if Pic.Floater = '#' and then Currency_Pos /= 0 then
raise Layout_Error;
end if;
if Pic.Start_Currency = Invalid_Position then
Position := Answer'Last + 1;
else
Position := Pic.Start_Currency;
end if;
end if;
for J in Position .. Answer'Last loop
if Pic.Start_Currency /= Invalid_Position and then
Answer (Pic.Start_Currency) = '#' then
Currency_Pos := 1;
end if;
case Answer (J) is
when '*' =>
Answer (J) := Fill_Character;
when 'b' =>
Answer (J) := ' ';
when '#' =>
if Currency_Pos > Currency_Symbol'Length then
Answer (J) := ' ';
else
Answer (J) := Currency_Symbol (Currency_Pos);
Currency_Pos := Currency_Pos + 1;
end if;
when '_' =>
case Pic.Floater is
when '*' =>
Answer (J) := Fill_Character;
when 'Z' | 'z' =>
Answer (J) := ' ';
when '#' =>
if Currency_Pos > Currency_Symbol'Length then
Answer (J) := ' ';
else
Answer (J) := Currency_Symbol (Currency_Pos);
Currency_Pos := Currency_Pos + 1;
end if;
when others =>
null;
end case;
when others =>
exit;
end case;
end loop;
if Zero and Pic.Blank_When_Zero then
Last := Answer'Last;
if Dollar then
Last := Last - 1 + Currency_Symbol'Length;
end if;
if Pic.Radix_Position /= Invalid_Position and then
Answer (Pic.Radix_Position) = 'V' then
Last := Last - 1;
end if;
return Wide_String'(1 .. Last => ' ');
elsif Zero and Pic.Star_Fill then
Last := Answer'Last;
if Dollar then
Last := Last - 1 + Currency_Symbol'Length;
end if;
if Pic.Radix_Position /= Invalid_Position then
if Answer (Pic.Radix_Position) = 'V' then
Last := Last - 1;
elsif Dollar then
if Pic.Radix_Position > Pic.Start_Currency then
return Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
Radix_Point &
Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
else
return
Wide_String'
(1 ..
Pic.Radix_Position + Currency_Symbol'Length - 2
=> '*') &
Radix_Point &
Wide_String'
(Pic.Radix_Position + Currency_Symbol'Length .. Last
=> '*');
end if;
else
return
Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
Radix_Point &
Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
end if;
end if;
return Wide_String'(1 .. Last => '*');
end if;
if Pic.Radix_Position /= Invalid_Position then
if Answer (Pic.Radix_Position) = '.' then
Answer (Pic.Radix_Position) := Radix_Point;
if Dollar then
return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
Answer (Currency_Pos + 1 .. Answer'Last);
else
return Answer;
end if;
elsif Answer (Pic.Radix_Position) = ' ' then if Dollar then
return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
Answer (Currency_Pos + 1 .. Answer'Last);
else
return Answer;
end if;
else
if not Dollar then
return Answer (1 .. Pic.Radix_Position - 1) &
Answer (Pic.Radix_Position + 1 .. Answer'Last);
elsif Currency_Pos < Pic.Radix_Position then
return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
Answer (Pic.Radix_Position + 1 .. Answer'Last);
else
return Answer (1 .. Pic.Radix_Position - 1) &
Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
Currency_Symbol &
Answer (Currency_Pos + 1 .. Answer'Last);
end if;
end if;
elsif Dollar then
return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
Answer (Currency_Pos + 1 .. Answer'Last);
else
return Answer;
end if;
end Format_Number;
function Parse_Number_String (Str : String) return Number_Attributes is
Answer : Number_Attributes;
begin
for J in Str'Range loop
case Str (J) is
when ' ' =>
null;
when '1' .. '9' =>
if Answer.Has_Fraction then
Answer.End_Of_Fraction := J;
else
if Answer.Start_Of_Int = Invalid_Position then
Answer.Start_Of_Int := J;
end if;
Answer.End_Of_Int := J;
end if;
when '0' =>
if not Answer.Has_Fraction then
if Answer.Start_Of_Int /= Invalid_Position then
Answer.End_Of_Int := J;
end if;
end if;
when '-' =>
Answer.Negative := True;
when '.' =>
if Answer.Has_Fraction then
raise Picture_Error;
end if;
Answer.Has_Fraction := True;
Answer.End_Of_Fraction := J;
Answer.Start_Of_Fraction := J + 1;
Answer.End_Of_Int := J - 1;
when others =>
raise Picture_Error; end case;
end loop;
if Answer.Start_Of_Int = Invalid_Position then
Answer.Start_Of_Int := Answer.End_Of_Int + 1;
end if;
return Answer;
end Parse_Number_String;
function Pic_String (Pic : in Picture) return String is
Temp : String (1 .. Pic.Contents.Picture.Length) :=
Pic.Contents.Picture.Expanded;
begin
for J in Temp'Range loop
if Temp (J) = 'b' then Temp (J) := 'B'; end if;
end loop;
return Temp;
end Pic_String;
procedure Precalculate (Pic : in out Format_Record) is
Computed_BWZ : Boolean := True;
type Legality is (Okay, Reject);
State : Legality := Reject;
Index : Pic_Index := Pic.Picture.Expanded'First;
function At_End return Boolean;
pragma Inline (At_End);
procedure Set_State (L : Legality);
pragma Inline (Set_State);
function Look return Character;
pragma Inline (Look);
function Is_Insert return Boolean;
pragma Inline (Is_Insert);
procedure Skip;
pragma Inline (Skip);
procedure Trailing_Currency;
procedure Trailing_Bracket;
procedure Number_Fraction;
procedure Number_Completion;
procedure Number_Fraction_Or_Bracket;
procedure Number_Fraction_Or_Z_Fill;
procedure Zero_Suppression;
procedure Floating_Bracket;
procedure Number_Fraction_Or_Star_Fill;
procedure Star_Suppression;
procedure Number_Fraction_Or_Dollar;
procedure Leading_Dollar;
procedure Number_Fraction_Or_Pound;
procedure Leading_Pound;
procedure Picture;
procedure Floating_Plus;
procedure Floating_Minus;
procedure Picture_Plus;
procedure Picture_Minus;
procedure Picture_Bracket;
procedure Number;
procedure Optional_RHS_Sign;
procedure Picture_String;
function At_End return Boolean is
begin
return Index > Pic.Picture.Length;
end At_End;
procedure Floating_Bracket is
begin
Pic.Floater := '<';
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '<' =>
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Skip;
when '9' =>
Number_Completion;
when '$' =>
Leading_Dollar;
when '#' =>
Leading_Pound;
when 'V' | 'v' | '.' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction_Or_Bracket;
return;
when others =>
return;
end case;
end loop;
end Floating_Bracket;
procedure Floating_Minus is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '-' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
when '9' =>
Number_Completion;
return;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip;
while Is_Insert loop
Skip;
end loop;
if At_End then
return;
end if;
if Look = '-' then
loop
if At_End then
return;
end if;
case Look is
when '-' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when others =>
return;
end case;
end loop;
else
Number_Completion;
end if;
return;
when others =>
return;
end case;
end loop;
end Floating_Minus;
procedure Floating_Plus is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '+' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
when '9' =>
Number_Completion;
return;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip;
while Is_Insert loop
Skip;
end loop;
if At_End then
return;
end if;
if Look = '+' then
loop
if At_End then
return;
end if;
case Look is
when '+' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when others =>
return;
end case;
end loop;
else
Number_Completion;
end if;
return;
when others =>
return;
end case;
end loop;
end Floating_Plus;
function Is_Insert return Boolean is
begin
if At_End then
return False;
end if;
case Pic.Picture.Expanded (Index) is
when '_' | '0' | '/' => return True;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b'; return True;
when others => return False;
end case;
end Is_Insert;
procedure Leading_Dollar is
begin
Pic.Floater := '$';
Pic.Start_Currency := Index;
Pic.End_Currency := Index;
Pic.Start_Float := Index;
Pic.End_Float := Index;
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
if Look /= '$' then
Pic.End_Float := Pic.End_Float - 1;
end if;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
if State = Okay then
raise Picture_Error;
else
Zero_Suppression;
end if;
when '*' =>
if State = Okay then
raise Picture_Error;
else
Star_Suppression;
end if;
when '$' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Pic.End_Currency := Index;
Set_State (Okay); Skip;
when '9' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Number_Completion;
return;
when 'V' | 'v' | '.' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Pic.Radix_Position := Index;
Skip;
Number_Fraction_Or_Dollar;
return;
when others =>
return;
end case;
end loop;
end Leading_Dollar;
procedure Leading_Pound is
Inserts : Boolean := False;
Must_Float : Boolean := False;
begin
Pic.Floater := '#';
Pic.Start_Currency := Index;
Pic.End_Currency := Index;
Pic.Start_Float := Index;
Pic.End_Float := Index;
Pic.Max_Currency_Digits := 1;
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Inserts := True;
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Pic.End_Float := Index;
Inserts := True;
Skip;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
if Must_Float then
raise Picture_Error;
else
Pic.Max_Leading_Digits := 0;
Zero_Suppression;
end if;
when '*' =>
if Must_Float then
raise Picture_Error;
else
Pic.Max_Leading_Digits := 0;
Star_Suppression;
end if;
when '#' =>
if Inserts then
Must_Float := True;
end if;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Pic.End_Currency := Index;
Set_State (Okay);
Skip;
when '9' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Number_Completion;
return;
when 'V' | 'v' | '.' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Pic.Radix_Position := Index;
Skip;
Number_Fraction_Or_Pound;
return;
when others =>
return;
end case;
end loop;
end Leading_Pound;
function Look return Character is
begin
if At_End then
raise Picture_Error;
end if;
return Pic.Picture.Expanded (Index);
end Look;
procedure Number is
begin
loop
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '9' =>
Computed_BWZ := False;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Set_State (Okay);
Skip;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction;
return;
when others =>
return;
end case;
if At_End then
return;
end if;
end loop;
end Number;
procedure Number_Completion is
begin
while not At_End loop
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '9' =>
Computed_BWZ := False;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Set_State (Okay);
Skip;
when 'V' | 'v' | '.' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction;
return;
when others =>
return;
end case;
end loop;
end Number_Completion;
procedure Number_Fraction is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '9' =>
Computed_BWZ := False;
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Set_State (Okay); Skip;
when others =>
return;
end case;
end loop;
end Number_Fraction;
procedure Number_Fraction_Or_Bracket is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '<' =>
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '<' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others =>
return;
end case;
end loop;
when others =>
Number_Fraction;
return;
end case;
end loop;
end Number_Fraction_Or_Bracket;
procedure Number_Fraction_Or_Dollar is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '$' =>
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '$' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others =>
return;
end case;
end loop;
when others =>
Number_Fraction;
return;
end case;
end loop;
end Number_Fraction_Or_Dollar;
procedure Number_Fraction_Or_Pound is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '#' =>
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '#' =>
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others =>
return;
end case;
end loop;
when others =>
Number_Fraction;
return;
end case;
end loop;
end Number_Fraction_Or_Pound;
procedure Number_Fraction_Or_Star_Fill is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '*' =>
Pic.Star_Fill := True;
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '*' =>
Pic.Star_Fill := True;
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others =>
return;
end case;
end loop;
when others =>
Number_Fraction;
return;
end case;
end loop;
end Number_Fraction_Or_Star_Fill;
procedure Number_Fraction_Or_Z_Fill is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when 'Z' | 'z' =>
Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'Z';
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
Pic.Max_Trailing_Digits :=
Pic.Max_Trailing_Digits + 1;
Pic.End_Float := Index;
Skip;
when others =>
return;
end case;
end loop;
when others =>
Number_Fraction;
return;
end case;
end loop;
end Number_Fraction_Or_Z_Fill;
procedure Optional_RHS_Sign is
begin
if At_End then
return;
end if;
case Look is
when '+' | '-' =>
Pic.Sign_Position := Index;
Skip;
return;
when 'C' | 'c' =>
Pic.Sign_Position := Index;
Pic.Picture.Expanded (Index) := 'C';
Skip;
if Look = 'R' or Look = 'r' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'R';
Skip;
else
raise Picture_Error;
end if;
return;
when 'D' | 'd' =>
Pic.Sign_Position := Index;
Pic.Picture.Expanded (Index) := 'D';
Skip;
if Look = 'B' or Look = 'b' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'B';
Skip;
else
raise Picture_Error;
end if;
return;
when '>' =>
if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
Pic.Second_Sign := Index;
Skip;
else
raise Picture_Error;
end if;
when others =>
return;
end case;
end Optional_RHS_Sign;
procedure Picture is
begin
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '$' =>
Leading_Dollar;
return;
when '#' =>
Leading_Pound;
return;
when '9' =>
Computed_BWZ := False;
Set_State (Okay);
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Skip;
when 'V' | 'v' | '.' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction;
Trailing_Currency;
return;
when others =>
return;
end case;
end loop;
end Picture;
procedure Picture_Bracket is
begin
Pic.Sign_Position := Index;
Pic.Sign_Position := Index;
Pic.Floater := '<';
Pic.Start_Float := Index;
Pic.End_Float := Index;
Skip;
loop
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '<' =>
Set_State (Okay); Floating_Bracket;
Trailing_Currency;
Trailing_Bracket;
return;
when '$' | '#' | '9' | '*' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
Trailing_Bracket;
Set_State (Okay);
return;
when '.' | 'V' | 'v' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
Trailing_Bracket;
return;
when others =>
raise Picture_Error;
end case;
end loop;
end Picture_Bracket;
procedure Picture_Minus is
begin
Pic.Sign_Position := Index;
Pic.Floater := '-';
Pic.Start_Float := Index;
Pic.End_Float := Index;
Skip;
loop
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '-' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
Set_State (Okay); Floating_Minus;
Trailing_Currency;
return;
when '$' | '#' | '9' | '*' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
Set_State (Okay);
return;
when 'Z' | 'z' =>
if State = Okay then
Set_State (Reject);
end if;
Pic.Picture.Expanded (Index) := 'Z'; Zero_Suppression;
Trailing_Currency;
Optional_RHS_Sign;
return;
when '.' | 'V' | 'v' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
return;
when others =>
return;
end case;
end loop;
end Picture_Minus;
procedure Picture_Plus is
begin
Pic.Sign_Position := Index;
Pic.Floater := '+';
Pic.Start_Float := Index;
Pic.End_Float := Index;
Skip;
loop
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '+' =>
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Skip;
Set_State (Okay); Floating_Plus;
Trailing_Currency;
return;
when '$' | '#' | '9' | '*' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
Set_State (Okay);
return;
when 'Z' | 'z' =>
if State = Okay then
Set_State (Reject);
end if;
Pic.Picture.Expanded (Index) := 'Z';
Set_State (Okay);
Zero_Suppression;
Trailing_Currency;
Optional_RHS_Sign;
return;
when '.' | 'V' | 'v' =>
if State /= Okay then
Pic.Floater := '!';
Pic.Start_Float := Invalid_Position;
Pic.End_Float := Invalid_Position;
end if;
Picture;
return;
when others =>
return;
end case;
end loop;
end Picture_Plus;
procedure Picture_String is
begin
while Is_Insert loop
Skip;
end loop;
case Look is
when '$' | '#' =>
Picture;
Optional_RHS_Sign;
when '+' =>
Picture_Plus;
when '-' =>
Picture_Minus;
when '<' =>
Picture_Bracket;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z'; Zero_Suppression;
Trailing_Currency;
Optional_RHS_Sign;
when '*' =>
Star_Suppression;
Trailing_Currency;
Optional_RHS_Sign;
when '9' | '.' | 'V' | 'v' =>
Number;
Trailing_Currency;
Optional_RHS_Sign;
when others =>
raise Picture_Error;
end case;
Pic.Blank_When_Zero :=
(Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
if not At_End then
Set_State (Reject);
end if;
end Picture_String;
procedure Set_State (L : Legality) is
begin
State := L;
end Set_State;
procedure Skip is
begin
Index := Index + 1;
end Skip;
procedure Star_Suppression is
begin
Pic.Floater := '*';
Pic.Start_Float := Index;
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Set_State (Okay);
Pic.Star_Fill := True;
Skip;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when '*' =>
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Set_State (Okay); Skip;
when '9' =>
Set_State (Okay);
Number_Completion;
return;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction_Or_Star_Fill;
return;
when '#' | '$' =>
Trailing_Currency;
Set_State (Okay);
return;
when others => raise Picture_Error;
end case;
end loop;
end Star_Suppression;
procedure Trailing_Bracket is
begin
if Look = '>' then
Pic.Second_Sign := Index;
Skip;
else
raise Picture_Error;
end if;
end Trailing_Bracket;
procedure Trailing_Currency is
begin
if At_End then
return;
end if;
if Look = '$' then
Pic.Start_Currency := Index;
Pic.End_Currency := Index;
Skip;
else
while not At_End and then Look = '#' loop
if Pic.Start_Currency = Invalid_Position then
Pic.Start_Currency := Index;
end if;
Pic.End_Currency := Index;
Skip;
end loop;
end if;
loop
if At_End then
return;
end if;
case Look is
when '_' | '0' | '/' => Skip;
when 'B' | 'b' =>
Pic.Picture.Expanded (Index) := 'b';
Skip;
when others => return;
end case;
end loop;
end Trailing_Currency;
procedure Zero_Suppression is
begin
Pic.Floater := 'Z';
Pic.Start_Float := Index;
Pic.End_Float := Index;
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.Picture.Expanded (Index) := 'Z';
Skip;
loop
if At_End then
Set_State (Okay);
return;
end if;
case Look is
when '_' | '0' | '/' =>
Pic.End_Float := Index;
Skip;
when 'B' | 'b' =>
Pic.End_Float := Index;
Pic.Picture.Expanded (Index) := 'b';
Skip;
when 'Z' | 'z' =>
Pic.Picture.Expanded (Index) := 'Z';
Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
Pic.End_Float := Index;
Set_State (Okay);
Skip;
when '9' =>
Set_State (Okay);
Number_Completion;
return;
when '.' | 'V' | 'v' =>
Pic.Radix_Position := Index;
Skip;
Number_Fraction_Or_Z_Fill;
return;
when '#' | '$' =>
Trailing_Currency;
Set_State (Okay);
return;
when others =>
return;
end case;
end loop;
end Zero_Suppression;
begin
Picture_String;
if State = Reject then
raise Picture_Error;
end if;
exception
when Constraint_Error =>
raise Picture_Error;
end Precalculate;
function To_Picture
(Pic_String : String;
Blank_When_Zero : Boolean := False) return Picture
is
Result : Picture;
begin
declare
Item : constant String := Expand (Pic_String);
begin
Result.Contents.Picture := (Item'Length, Item);
Result.Contents.Original_BWZ := Blank_When_Zero;
Result.Contents.Blank_When_Zero := Blank_When_Zero;
Precalculate (Result.Contents);
return Result;
end;
exception
when others =>
raise Picture_Error;
end To_Picture;
function To_Wide (C : Character) return Wide_Character is
begin
return Wide_Character'Val (Character'Pos (C));
end To_Wide;
function Valid
(Pic_String : String;
Blank_When_Zero : Boolean := False) return Boolean
is
begin
declare
Expanded_Pic : constant String := Expand (Pic_String);
Format_Rec : Format_Record;
begin
Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
Format_Rec.Blank_When_Zero := Blank_When_Zero;
Format_Rec.Original_BWZ := Blank_When_Zero;
Precalculate (Format_Rec);
return not Blank_When_Zero or
Strings_Fixed.Index (Expanded_Pic, "*") = 0;
end;
exception
when others => return False;
end Valid;
end Ada.Wide_Text_IO.Editing;