| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT RUNTIME COMPONENTS -- |
| -- -- |
| -- A D A . T E X T _ I O . E D I T I N G -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2003 Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 2, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING. If not, write -- |
| -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- |
| -- MA 02111-1307, USA. -- |
| -- -- |
| -- As a special exception, if other files instantiate generics from this -- |
| -- unit, or you link this unit with other files to produce an executable, -- |
| -- this unit does not by itself cause the resulting executable to be -- |
| -- covered by the GNU General Public License. This exception does not -- |
| -- however invalidate any other reasons why the executable file might be -- |
| -- covered by the GNU Public License. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Ada.Strings.Fixed; |
| package body Ada.Text_IO.Editing is |
| |
| package Strings renames Ada.Strings; |
| package Strings_Fixed renames Ada.Strings.Fixed; |
| package Text_IO renames Ada.Text_IO; |
| |
| --------------------- |
| -- Blank_When_Zero -- |
| --------------------- |
| |
| function Blank_When_Zero (Pic : in Picture) return Boolean is |
| begin |
| return Pic.Contents.Original_BWZ; |
| end Blank_When_Zero; |
| |
| ------------ |
| -- Expand -- |
| ------------ |
| |
| 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; |
| |
| package Int_IO is new Ada.Text_IO.Integer_IO (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 '(' => |
| Int_IO.Get (Picture (Picture_Index + 1 .. Picture'Last), |
| Count, Last); |
| |
| if Picture (Last + 1) /= ')' then |
| raise Picture_Error; |
| end if; |
| |
| -- In what follows note that one copy of the repeated |
| -- character has already been made, so a count of one is a |
| -- no-op, and a count of zero erases a character. |
| |
| for J in 2 .. Count loop |
| Result (Result_Index + J - 2) := Picture (Picture_Index - 1); |
| end loop; |
| |
| Result_Index := Result_Index + Count - 1; |
| |
| -- Last + 1 was a ')' throw it away too. |
| |
| Picture_Index := Last + 2; |
| |
| 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; |
| |
| ------------------- |
| -- Format_Number -- |
| ------------------- |
| |
| function Format_Number |
| (Pic : Format_Record; |
| Number : String; |
| Currency_Symbol : String; |
| Fill_Character : Character; |
| Separator_Character : Character; |
| Radix_Point : Character) |
| return String |
| is |
| Attrs : Number_Attributes := Parse_Number_String (Number); |
| Position : Integer; |
| Rounded : String := Number; |
| |
| Sign_Position : Integer := Pic.Sign_Position; -- may float. |
| |
| Answer : String (1 .. Pic.Picture.Length) := Pic.Picture.Expanded; |
| Last : Integer; |
| Currency_Pos : Integer := Pic.Start_Currency; |
| In_Currency : Boolean := False; |
| |
| Dollar : Boolean := False; |
| -- Overridden immediately if necessary. |
| |
| Zero : Boolean := True; |
| -- Set to False when a non-zero digit is output. |
| |
| begin |
| |
| -- If the picture has fewer decimal places than the number, the image |
| -- must be rounded according to the usual rules. |
| |
| 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 := Attrs.End_Of_Fraction - 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; |
| |
| -- The rounding may add a digit in front. Either the |
| -- leading blank or the sign (already captured) can |
| -- be overwritten. |
| |
| 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; |
| |
| if Pic.Start_Currency /= Invalid_Position then |
| Dollar := Answer (Pic.Start_Currency) = '$'; |
| end if; |
| |
| -- Fix up "direct inserts" outside the playing field. Set up as one |
| -- loop to do the beginning, one (reverse) loop to do the end. |
| |
| 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; |
| |
| -- Now for the end... |
| |
| for J in reverse Last .. Answer'Last loop |
| exit when J = Pic.Radix_Position; |
| |
| -- Do this test First, Separator_Character can equal Pic.Floater. |
| |
| 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; |
| |
| -- Non-floating sign |
| |
| 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; |
| |
| -- Fill in leading digits |
| |
| if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 > |
| Pic.Max_Leading_Digits |
| then |
| raise Ada.Text_IO.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) := Rounded (J); |
| |
| if Rounded (J) /= '0' then |
| Zero := False; |
| end if; |
| |
| Position := Position - 1; |
| end loop; |
| |
| -- Do lead float |
| |
| if Pic.Start_Float = Invalid_Position then |
| |
| -- No leading floats, but need to change '9' to '0', '_' to |
| -- Separator_Character and 'b' to ' '. |
| |
| for J in Last .. Position loop |
| |
| -- Last set when fixing the "uninteresting" leaders above. |
| -- Don't duplicate the work. |
| |
| 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 -- May be null range. |
| 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 -- May be null range. |
| if Answer (J) = '9' then |
| Answer (J) := '0'; |
| |
| elsif Answer (J) = '_' then |
| Answer (J) := ' '; -- no separators before leftmost digit. |
| |
| 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 -- May be null range. |
| 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; |
| In_Currency := True; |
| end if; |
| |
| for J in reverse Pic.Start_Float .. Position loop |
| case Answer (J) is |
| |
| when '*' => |
| Answer (J) := Fill_Character; |
| |
| when 'b' | '/' => |
| if In_Currency and then Currency_Pos > 0 then |
| Answer (J) := Currency_Symbol (Currency_Pos); |
| Currency_Pos := Currency_Pos - 1; |
| else |
| Answer (J) := ' '; |
| end if; |
| |
| when 'Z' | '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 Ada.Text_IO.Layout_Error; |
| end if; |
| end if; |
| |
| -- Do sign |
| |
| if Sign_Position = Invalid_Position then |
| if Attrs.Negative then |
| raise Ada.Text_IO.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 -- positive |
| |
| 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; |
| |
| -- Fill in trailing digits |
| |
| 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) := Rounded (Position); |
| |
| if Rounded (Position) /= '0' then |
| Zero := False; |
| end if; |
| |
| Position := Position + 1; |
| Last := J + 1; |
| |
| -- Used up fraction but remember place in Answer |
| |
| 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; |
| |
| -- Now fill remaining 9's with zeros and _ with separators |
| |
| 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 Ada.Text_IO.Layout_Error; |
| end if; |
| |
| -- No trailing digits, but now J may need to stick in a currency |
| -- symbol or sign. |
| |
| 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' => |
| if In_Currency then |
| Answer (J) := Currency_Symbol (Currency_Pos); |
| Currency_Pos := Currency_Pos + 1; |
| |
| if Currency_Pos > Currency_Symbol'Length then |
| In_Currency := False; |
| end if; |
| end if; |
| |
| when '#' => |
| if Currency_Pos > Currency_Symbol'Length then |
| Answer (J) := ' '; |
| |
| else |
| In_Currency := True; |
| Answer (J) := Currency_Symbol (Currency_Pos); |
| Currency_Pos := Currency_Pos + 1; |
| |
| if Currency_Pos > Currency_Symbol'Length then |
| In_Currency := False; |
| end if; |
| end if; |
| |
| when '_' => |
| Answer (J) := Currency_Symbol (Currency_Pos); |
| Currency_Pos := Currency_Pos + 1; |
| |
| 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; |
| |
| -- Now get rid of Blank_when_Zero and complete Star fill. |
| |
| if Zero and Pic.Blank_When_Zero then |
| |
| -- Value is zero, and blank it. |
| |
| 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 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 String'(1 .. Pic.Radix_Position - 1 => '*') & |
| Radix_Point & |
| String'(Pic.Radix_Position + 1 .. Last => '*'); |
| |
| else |
| return |
| String' |
| (1 .. |
| Pic.Radix_Position + Currency_Symbol'Length - 2 => |
| '*') & Radix_Point & |
| String' |
| (Pic.Radix_Position + Currency_Symbol'Length .. Last |
| => '*'); |
| end if; |
| |
| else |
| return String'(1 .. Pic.Radix_Position - 1 => '*') & |
| Radix_Point & |
| String'(Pic.Radix_Position + 1 .. Last => '*'); |
| end if; |
| end if; |
| |
| return String'(1 .. Last => '*'); |
| end if; |
| |
| -- This was once a simple return statement, now there are nine |
| -- different return cases. Not to mention the five above to deal |
| -- with zeros. Why not split things out? |
| |
| -- Processing the radix and sign expansion separately |
| -- would require lots of copying--the string and some of its |
| -- indicies--without really simplifying the logic. The cases are: |
| |
| -- 1) Expand $, replace '.' with Radix_Point |
| -- 2) No currency expansion, replace '.' with Radix_Point |
| -- 3) Expand $, radix blanked |
| -- 4) No currency expansion, radix blanked |
| -- 5) Elide V |
| -- 6) Expand $, Elide V |
| -- 7) Elide V, Expand $ (Two cases depending on order.) |
| -- 8) No radix, expand $ |
| -- 9) No radix, no currency expansion |
| |
| if Pic.Radix_Position /= Invalid_Position then |
| |
| if Answer (Pic.Radix_Position) = '.' then |
| Answer (Pic.Radix_Position) := Radix_Point; |
| |
| if Dollar then |
| |
| -- 1) Expand $, replace '.' with Radix_Point |
| |
| return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & |
| Answer (Currency_Pos + 1 .. Answer'Last); |
| |
| else |
| -- 2) No currency expansion, replace '.' with Radix_Point |
| |
| return Answer; |
| end if; |
| |
| elsif Answer (Pic.Radix_Position) = ' ' then -- blanked radix. |
| if Dollar then |
| |
| -- 3) Expand $, radix blanked |
| |
| return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & |
| Answer (Currency_Pos + 1 .. Answer'Last); |
| |
| else |
| -- 4) No expansion, radix blanked |
| |
| return Answer; |
| end if; |
| |
| -- V cases |
| |
| else |
| if not Dollar then |
| |
| -- 5) Elide V |
| |
| return Answer (1 .. Pic.Radix_Position - 1) & |
| Answer (Pic.Radix_Position + 1 .. Answer'Last); |
| |
| elsif Currency_Pos < Pic.Radix_Position then |
| |
| -- 6) Expand $, Elide V |
| |
| return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & |
| Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) & |
| Answer (Pic.Radix_Position + 1 .. Answer'Last); |
| |
| else |
| -- 7) Elide V, Expand $ |
| |
| 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 |
| |
| -- 8) No radix, expand $ |
| |
| return Answer (1 .. Currency_Pos - 1) & Currency_Symbol & |
| Answer (Currency_Pos + 1 .. Answer'Last); |
| |
| else |
| -- 9) No radix, no currency expansion |
| |
| return Answer; |
| end if; |
| end Format_Number; |
| |
| ------------------------- |
| -- Parse_Number_String -- |
| ------------------------- |
| |
| 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; -- ignore |
| |
| when '1' .. '9' => |
| |
| -- Decide if this is the start of a number. |
| -- If so, figure out which one... |
| |
| if Answer.Has_Fraction then |
| Answer.End_Of_Fraction := J; |
| else |
| if Answer.Start_Of_Int = Invalid_Position then |
| -- start integer |
| Answer.Start_Of_Int := J; |
| end if; |
| Answer.End_Of_Int := J; |
| end if; |
| |
| when '0' => |
| |
| -- Only count a zero before the decimal point if it follows a |
| -- non-zero digit. After the decimal point, zeros will be |
| -- counted if followed by a non-zero digit. |
| |
| if not Answer.Has_Fraction then |
| if Answer.Start_Of_Int /= Invalid_Position then |
| Answer.End_Of_Int := J; |
| end if; |
| end if; |
| |
| when '-' => |
| |
| -- Set negative |
| |
| Answer.Negative := True; |
| |
| when '.' => |
| |
| -- Close integer, start fraction |
| |
| if Answer.Has_Fraction then |
| raise Picture_Error; |
| end if; |
| |
| -- Two decimal points is a no-no. |
| |
| Answer.Has_Fraction := True; |
| Answer.End_Of_Fraction := J; |
| |
| -- Could leave this at Invalid_Position, but this seems the |
| -- right way to indicate a null range... |
| |
| Answer.Start_Of_Fraction := J + 1; |
| Answer.End_Of_Int := J - 1; |
| |
| when others => |
| raise Picture_Error; -- can this happen? probably not! |
| end case; |
| end loop; |
| |
| if Answer.Start_Of_Int = Invalid_Position then |
| Answer.Start_Of_Int := Answer.End_Of_Int + 1; |
| end if; |
| |
| -- No significant (intger) digits needs a null range. |
| |
| return Answer; |
| end Parse_Number_String; |
| |
| ---------------- |
| -- Pic_String -- |
| ---------------- |
| |
| -- The following ensures that we return B and not b being careful not |
| -- to break things which expect lower case b for blank. See CXF3A02. |
| |
| 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; |
| |
| ------------------ |
| -- Precalculate -- |
| ------------------ |
| |
| procedure Precalculate (Pic : in out Format_Record) is |
| Debug : constant Boolean := False; |
| -- Set True to generate debug output |
| |
| Computed_BWZ : Boolean := True; |
| |
| type Legality is (Okay, Reject); |
| |
| State : Legality := Reject; |
| -- Start in reject, which will reject null strings. |
| |
| 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 Debug_Start (Name : String); |
| pragma Inline (Debug_Start); |
| |
| procedure Debug_Integer (Value : in Integer; S : String); |
| pragma Inline (Debug_Integer); |
| |
| 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; |
| procedure Set_Debug; |
| |
| ------------ |
| -- At_End -- |
| ------------ |
| |
| function At_End return Boolean is |
| begin |
| Debug_Start ("At_End"); |
| return Index > Pic.Picture.Length; |
| end At_End; |
| |
| -------------- |
| -- Set_Debug-- |
| -------------- |
| |
| -- Needed to have a procedure to pass to pragma Debug |
| |
| procedure Set_Debug is |
| begin |
| -- Uncomment this line and make Debug a variable to enable debug |
| |
| -- Debug := True; |
| |
| null; |
| end Set_Debug; |
| |
| ------------------- |
| -- Debug_Integer -- |
| ------------------- |
| |
| procedure Debug_Integer (Value : in Integer; S : String) is |
| use Ada.Text_IO; -- needed for > |
| |
| begin |
| if Debug and then Value > 0 then |
| if Ada.Text_IO.Col > 70 - S'Length then |
| Ada.Text_IO.New_Line; |
| end if; |
| |
| Ada.Text_IO.Put (' ' & S & Integer'Image (Value) & ','); |
| end if; |
| end Debug_Integer; |
| |
| ----------------- |
| -- Debug_Start -- |
| ----------------- |
| |
| procedure Debug_Start (Name : String) is |
| begin |
| if Debug then |
| Ada.Text_IO.Put_Line (" In " & Name & '.'); |
| end if; |
| end Debug_Start; |
| |
| ---------------------- |
| -- Floating_Bracket -- |
| ---------------------- |
| |
| -- Note that Floating_Bracket is only called with an acceptable |
| -- prefix. But we don't set Okay, because we must end with a '>'. |
| |
| procedure Floating_Bracket is |
| begin |
| Debug_Start ("Floating_Bracket"); |
| |
| -- Two different floats not allowed. |
| |
| if Pic.Floater /= '!' and then Pic.Floater /= '<' then |
| raise Picture_Error; |
| |
| else |
| Pic.Floater := '<'; |
| end if; |
| |
| Pic.End_Float := Index; |
| Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; |
| |
| -- First bracket wasn't counted... |
| |
| Skip; -- known '<' |
| |
| 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; |
| |
| -------------------- |
| -- Floating_Minus -- |
| -------------------- |
| |
| procedure Floating_Minus is |
| begin |
| Debug_Start ("Floating_Minus"); |
| |
| 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; -- Radix |
| |
| 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; |
| |
| ------------------- |
| -- Floating_Plus -- |
| ------------------- |
| |
| procedure Floating_Plus is |
| begin |
| Debug_Start ("Floating_Plus"); |
| |
| 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; -- Radix |
| |
| 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; |
| |
| --------------- |
| -- Is_Insert -- |
| --------------- |
| |
| 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'; -- canonical |
| return True; |
| |
| when others => return False; |
| end case; |
| end Is_Insert; |
| |
| -------------------- |
| -- Leading_Dollar -- |
| -------------------- |
| |
| -- Note that Leading_Dollar can be called in either State. |
| -- It will set state to Okay only if a 9 or (second) $ |
| -- is encountered. |
| |
| -- Also notice the tricky bit with State and Zero_Suppression. |
| -- Zero_Suppression is Picture_Error if a '$' or a '9' has been |
| -- encountered, exactly the cases where State has been set. |
| |
| procedure Leading_Dollar is |
| begin |
| Debug_Start ("Leading_Dollar"); |
| |
| -- Treat as a floating dollar, and unwind otherwise |
| |
| if Pic.Floater /= '!' and then Pic.Floater /= '$' then |
| |
| -- Two floats not allowed |
| |
| raise Picture_Error; |
| |
| else |
| Pic.Floater := '$'; |
| end if; |
| |
| Pic.Start_Currency := Index; |
| Pic.End_Currency := Index; |
| Pic.Start_Float := Index; |
| Pic.End_Float := Index; |
| |
| -- Don't increment Pic.Max_Leading_Digits, we need one "real" |
| -- currency place. |
| |
| Skip; -- known '$' |
| |
| loop |
| if At_End then |
| return; |
| end if; |
| |
| case Look is |
| |
| when '_' | '0' | '/' => |
| Pic.End_Float := Index; |
| Skip; |
| |
| -- A trailing insertion character is not part of the |
| -- floating currency, so need to look ahead. |
| |
| 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'; -- consistency |
| |
| if State = Okay then |
| raise Picture_Error; |
| else |
| -- Overwrite Floater and Start_Float |
| |
| Pic.Floater := 'Z'; |
| Pic.Start_Float := Index; |
| Zero_Suppression; |
| end if; |
| |
| when '*' => |
| if State = Okay then |
| raise Picture_Error; |
| else |
| -- Overwrite Floater and Start_Float |
| Pic.Floater := '*'; |
| Pic.Start_Float := Index; |
| 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; |
| |
| -- A single dollar does not a floating make. |
| |
| Number_Completion; |
| return; |
| |
| when 'V' | 'v' | '.' => |
| if State /= Okay then |
| Pic.Floater := '!'; |
| Pic.Start_Float := Invalid_Position; |
| Pic.End_Float := Invalid_Position; |
| end if; |
| |
| -- Only one dollar before the sign is okay, |
| -- but doesn't float. |
| |
| Pic.Radix_Position := Index; |
| Skip; |
| Number_Fraction_Or_Dollar; |
| return; |
| |
| when others => |
| return; |
| |
| end case; |
| end loop; |
| end Leading_Dollar; |
| |
| ------------------- |
| -- Leading_Pound -- |
| ------------------- |
| |
| -- This one is complex! A Leading_Pound can be fixed or floating, |
| -- but in some cases the decision has to be deferred until we leave |
| -- this procedure. Also note that Leading_Pound can be called in |
| -- either State. |
| |
| -- It will set state to Okay only if a 9 or (second) # is |
| -- encountered. |
| |
| -- One Last note: In ambiguous cases, the currency is treated as |
| -- floating unless there is only one '#'. |
| |
| procedure Leading_Pound is |
| |
| Inserts : Boolean := False; |
| -- Set to True if a '_', '0', '/', 'B', or 'b' is encountered |
| |
| Must_Float : Boolean := False; |
| -- Set to true if a '#' occurs after an insert. |
| |
| begin |
| Debug_Start ("Leading_Pound"); |
| |
| -- Treat as a floating currency. If it isn't, this will be |
| -- overwritten later. |
| |
| if Pic.Floater /= '!' and then Pic.Floater /= '#' then |
| |
| -- Two floats not allowed |
| |
| raise Picture_Error; |
| |
| else |
| Pic.Floater := '#'; |
| end if; |
| |
| Pic.Start_Currency := Index; |
| Pic.End_Currency := Index; |
| Pic.Start_Float := Index; |
| Pic.End_Float := Index; |
| |
| -- Don't increment Pic.Max_Leading_Digits, we need one "real" |
| -- currency place. |
| |
| Pic.Max_Currency_Digits := 1; -- we've seen one. |
| |
| Skip; -- known '#' |
| |
| 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'; -- consistency |
| |
| if Must_Float then |
| raise Picture_Error; |
| else |
| Pic.Max_Leading_Digits := 0; |
| |
| -- Overwrite Floater and Start_Float |
| |
| Pic.Floater := 'Z'; |
| Pic.Start_Float := Index; |
| Zero_Suppression; |
| end if; |
| |
| when '*' => |
| if Must_Float then |
| raise Picture_Error; |
| else |
| Pic.Max_Leading_Digits := 0; |
| |
| -- Overwrite Floater and Start_Float |
| Pic.Floater := '*'; |
| Pic.Start_Float := Index; |
| 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 |
| |
| -- A single '#' doesn't float. |
| |
| 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; |
| |
| -- Only one pound before the sign is okay, |
| -- but doesn't float. |
| |
| Pic.Radix_Position := Index; |
| Skip; |
| Number_Fraction_Or_Pound; |
| return; |
| |
| when others => |
| return; |
| end case; |
| end loop; |
| end Leading_Pound; |
| |
| ---------- |
| -- Look -- |
| ---------- |
| |
| function Look return Character is |
| begin |
| if At_End then |
| raise Picture_Error; |
| end if; |
| |
| return Pic.Picture.Expanded (Index); |
| end Look; |
| |
| ------------ |
| -- Number -- |
| ------------ |
| |
| procedure Number is |
| begin |
| Debug_Start ("Number"); |
| |
| 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; |
| |
| -- Will return in Okay state if a '9' was seen. |
| |
| end loop; |
| end Number; |
| |
| ----------------------- |
| -- Number_Completion -- |
| ----------------------- |
| |
| procedure Number_Completion is |
| begin |
| Debug_Start ("Number_Completion"); |
| |
| 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; |
| |
| --------------------- |
| -- Number_Fraction -- |
| --------------------- |
| |
| procedure Number_Fraction is |
| begin |
| -- Note that number fraction can be called in either State. |
| -- It will set state to Valid only if a 9 is encountered. |
| |
| Debug_Start ("Number_Fraction"); |
| |
| 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; |
| |
| -------------------------------- |
| -- Number_Fraction_Or_Bracket -- |
| -------------------------------- |
| |
| procedure Number_Fraction_Or_Bracket is |
| begin |
| Debug_Start ("Number_Fraction_Or_Bracket"); |
| |
| 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; |
| |
| ------------------------------- |
| -- Number_Fraction_Or_Dollar -- |
| ------------------------------- |
| |
| procedure Number_Fraction_Or_Dollar is |
| begin |
| Debug_Start ("Number_Fraction_Or_Dollar"); |
| |
| 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; |
| |
| ------------------------------ |
| -- Number_Fraction_Or_Pound -- |
| ------------------------------ |
| |
| 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; |
| |
| ---------------------------------- |
| -- Number_Fraction_Or_Star_Fill -- |
| ---------------------------------- |
| |
| procedure Number_Fraction_Or_Star_Fill is |
| begin |
| Debug_Start ("Number_Fraction_Or_Star_Fill"); |
| |
| 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; |
| |
| ------------------------------- |
| -- Number_Fraction_Or_Z_Fill -- |
| ------------------------------- |
| |
| procedure Number_Fraction_Or_Z_Fill is |
| begin |
| Debug_Start ("Number_Fraction_Or_Z_Fill"); |
| |
| 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'; -- consistency |
| |
| 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'; -- consistency |
| |
| 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; |
| |
| ----------------------- |
| -- Optional_RHS_Sign -- |
| ----------------------- |
| |
| procedure Optional_RHS_Sign is |
| begin |
| Debug_Start ("Optional_RHS_Sign"); |
| |
| 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; |
| |
| ------------- |
| -- Picture -- |
| ------------- |
| |
| -- Note that Picture can be called in either State. |
| |
| -- It will set state to Valid only if a 9 is encountered or floating |
| -- currency is called. |
| |
| procedure Picture is |
| begin |
| Debug_Start ("Picture"); |
| |
| 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; |
| |
| --------------------- |
| -- Picture_Bracket -- |
| --------------------- |
| |
| procedure Picture_Bracket is |
| begin |
| Pic.Sign_Position := Index; |
| Debug_Start ("Picture_Bracket"); |
| Pic.Sign_Position := Index; |
| |
| -- Treat as a floating sign, and unwind otherwise. |
| |
| Pic.Floater := '<'; |
| Pic.Start_Float := Index; |
| Pic.End_Float := Index; |
| |
| -- Don't increment Pic.Max_Leading_Digits, we need one "real" |
| -- sign place. |
| |
| Skip; -- Known Bracket |
| |
| 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); -- "<<>" is enough. |
| 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; |
| |
| -- Don't assume that state is okay, haven't seen a digit |
| |
| Picture; |
| Trailing_Bracket; |
| return; |
| |
| when others => |
| raise Picture_Error; |
| |
| end case; |
| end loop; |
| end Picture_Bracket; |
| |
| ------------------- |
| -- Picture_Minus -- |
| ------------------- |
| |
| procedure Picture_Minus is |
| begin |
| Debug_Start ("Picture_Minus"); |
| |
| Pic.Sign_Position := Index; |
| |
| -- Treat as a floating sign, and unwind otherwise. |
| |
| Pic.Floater := '-'; |
| Pic.Start_Float := Index; |
| Pic.End_Float := Index; |
| |
| -- Don't increment Pic.Max_Leading_Digits, we need one "real" |
| -- sign place. |
| |
| Skip; -- Known Minus |
| |
| 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); -- "-- " is enough. |
| 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' => |
| |
| -- Can't have Z and a floating sign. |
| |
| if State = Okay then |
| Set_State (Reject); |
| end if; |
| |
| Pic.Picture.Expanded (Index) := 'Z'; -- consistency |
| 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; |
| |
| -- Don't assume that state is okay, haven't seen a digit. |
| |
| Picture; |
| return; |
| |
| when others => |
| return; |
| |
| end case; |
| end loop; |
| end Picture_Minus; |
| |
| ------------------ |
| -- Picture_Plus -- |
| ------------------ |
| |
| procedure Picture_Plus is |
| begin |
| Debug_Start ("Picture_Plus"); |
| Pic.Sign_Position := Index; |
| |
| -- Treat as a floating sign, and unwind otherwise. |
| |
| Pic.Floater := '+'; |
| Pic.Start_Float := Index; |
| Pic.End_Float := Index; |
| |
| -- Don't increment Pic.Max_Leading_Digits, we need one "real" |
| -- sign place. |
| |
| Skip; -- Known Plus |
| |
| 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); -- "++" is enough. |
| 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; |
| |
| -- Can't have Z and a floating sign. |
| |
| Pic.Picture.Expanded (Index) := 'Z'; -- consistency |
| |
| -- '+Z' is acceptable |
| |
| Set_State (Okay); |
| |
| -- Overwrite Floater and Start_Float |
| |
| Pic.Floater := 'Z'; |
| Pic.Start_Float := Index; |
| |
| 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; |
| |
| -- Don't assume that state is okay, haven't seen a digit. |
| |
| Picture; |
| return; |
| |
| when others => |
| return; |
| |
| end case; |
| end loop; |
| end Picture_Plus; |
| |
| -------------------- |
| -- Picture_String -- |
| -------------------- |
| |
| procedure Picture_String is |
| begin |
| Debug_Start ("Picture_String"); |
| |
| 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'; -- consistency |
| 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; |
| |
| -- Blank when zero either if the PIC does not contain a '9' or if |
| -- requested by the user and no '*' |
| |
| Pic.Blank_When_Zero := |
| (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill; |
| |
| -- Star fill if '*' and no '9'. |
| |
| Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ; |
| |
| if not At_End then |
| Set_State (Reject); |
| end if; |
| |
| end Picture_String; |
| |
| --------------- |
| -- Set_State -- |
| --------------- |
| |
| procedure Set_State (L : Legality) is |
| begin |
| if Debug then Ada.Text_IO.Put_Line |
| (" Set state from " & Legality'Image (State) & |
| " to " & Legality'Image (L)); |
| end if; |
| |
| State := L; |
| end Set_State; |
| |
| ---------- |
| -- Skip -- |
| ---------- |
| |
| procedure Skip is |
| begin |
| if Debug then Ada.Text_IO.Put_Line |
| (" Skip " & Pic.Picture.Expanded (Index)); |
| end if; |
| |
| Index := Index + 1; |
| end Skip; |
| |
| ---------------------- |
| -- Star_Suppression -- |
| ---------------------- |
| |
| procedure Star_Suppression is |
| begin |
| Debug_Start ("Star_Suppression"); |
| |
| if Pic.Floater /= '!' and then Pic.Floater /= '*' then |
| |
| -- Two floats not allowed |
| |
| raise Picture_Error; |
| |
| else |
| Pic.Floater := '*'; |
| end if; |
| |
| Pic.Start_Float := Index; |
| Pic.End_Float := Index; |
| Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1; |
| Set_State (Okay); |
| |
| -- Even a single * is a valid picture |
| |
| Pic.Star_Fill := True; |
| Skip; -- Known * |
| |
| 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 '#' | '$' => |
| if Pic.Max_Currency_Digits > 0 then |
| raise Picture_Error; |
| end if; |
| |
| -- Cannot have leading and trailing currency |
| |
| Trailing_Currency; |
| Set_State (Okay); |
| return; |
| |
| when others => raise Picture_Error; |
| end case; |
| end loop; |
| end Star_Suppression; |
| |
| ---------------------- |
| -- Trailing_Bracket -- |
| ---------------------- |
| |
| procedure Trailing_Bracket is |
| begin |
| Debug_Start ("Trailing_Bracket"); |
| |
| if Look = '>' then |
| Pic.Second_Sign := Index; |
| Skip; |
| else |
| raise Picture_Error; |
| end if; |
| end Trailing_Bracket; |
| |
| ----------------------- |
| -- Trailing_Currency -- |
| ----------------------- |
| |
| procedure Trailing_Currency is |
| begin |
| Debug_Start ("Trailing_Currency"); |
| |
| 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; |
| |
| ---------------------- |
| -- Zero_Suppression -- |
| ---------------------- |
| |
| procedure Zero_Suppression is |
| begin |
| Debug_Start ("Zero_Suppression"); |
| |
| 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'; -- consistency |
| |
| Skip; -- Known Z |
| |
| loop |
| -- Even a single Z is a valid picture |
| |
| 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'; -- consistency |
| |
| 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; |
| |
| -- Start of processing for Precalculate |
| |
| begin |
| pragma Debug (Set_Debug); |
| |
| Picture_String; |
| |
| if Debug then |
| Ada.Text_IO.New_Line; |
| Ada.Text_IO.Put (" Picture : """ & |
| Pic.Picture.Expanded (1 .. Pic.Picture.Length) & ""","); |
| Ada.Text_IO.Put (" Floater : '" & Pic.Floater & "',"); |
| end if; |
| |
| if State = Reject then |
| raise Picture_Error; |
| end if; |
| |
| Debug_Integer (Pic.Radix_Position, "Radix Positon : "); |
| Debug_Integer (Pic.Sign_Position, "Sign Positon : "); |
| Debug_Integer (Pic.Second_Sign, "Second Sign : "); |
| Debug_Integer (Pic.Start_Float, "Start Float : "); |
| Debug_Integer (Pic.End_Float, "End Float : "); |
| Debug_Integer (Pic.Start_Currency, "Start Currency : "); |
| Debug_Integer (Pic.End_Currency, "End Currency : "); |
| Debug_Integer (Pic.Max_Leading_Digits, "Max Leading Digits : "); |
| Debug_Integer (Pic.Max_Trailing_Digits, "Max Trailing Digits : "); |
| |
| if Debug then |
| Ada.Text_IO.New_Line; |
| end if; |
| |
| exception |
| |
| when Constraint_Error => |
| |
| -- To deal with special cases like null strings. |
| |
| raise Picture_Error; |
| end Precalculate; |
| |
| ---------------- |
| -- To_Picture -- |
| ---------------- |
| |
| function To_Picture |
| (Pic_String : in String; |
| Blank_When_Zero : in 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; |
| |
| ----------- |
| -- Valid -- |
| ----------- |
| |
| function Valid |
| (Pic_String : in String; |
| Blank_When_Zero : in Boolean := False) |
| return Boolean |
| is |
| begin |
| declare |
| Expanded_Pic : constant String := Expand (Pic_String); |
| -- Raises Picture_Error if Item not well-formed |
| |
| 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); |
| |
| -- False only if Blank_When_Zero is True but the pic string has a '*' |
| |
| return not Blank_When_Zero or |
| Strings_Fixed.Index (Expanded_Pic, "*") = 0; |
| end; |
| |
| exception |
| when others => return False; |
| end Valid; |
| |
| -------------------- |
| -- Decimal_Output -- |
| -------------------- |
| |
| package body Decimal_Output is |
| |
| ----------- |
| -- Image -- |
| ----------- |
| |
| function Image |
| (Item : in Num; |
| Pic : in Picture; |
| Currency : in String := Default_Currency; |
| Fill : in Character := Default_Fill; |
| Separator : in Character := Default_Separator; |
| Radix_Mark : in Character := Default_Radix_Mark) |
| return String |
| is |
| begin |
| return Format_Number |
| (Pic.Contents, Num'Image (Item), |
| Currency, Fill, Separator, Radix_Mark); |
| end Image; |
| |
| ------------ |
| -- Length -- |
| ------------ |
| |
| function Length |
| (Pic : in Picture; |
| Currency : in String := Default_Currency) |
| return Natural |
| is |
| Picstr : constant String := Pic_String (Pic); |
| V_Adjust : Integer := 0; |
| Cur_Adjust : Integer := 0; |
| |
| begin |
| -- Check if Picstr has 'V' or '$' |
| |
| -- If 'V', then length is 1 less than otherwise |
| |
| -- If '$', then length is Currency'Length-1 more than otherwise |
| |
| -- This should use the string handling package ??? |
| |
| 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; |
| |
| --------- |
| -- Put -- |
| --------- |
| |
| procedure Put |
| (File : in Text_IO.File_Type; |
| Item : in Num; |
| Pic : in Picture; |
| Currency : in String := Default_Currency; |
| Fill : in Character := Default_Fill; |
| Separator : in Character := Default_Separator; |
| Radix_Mark : in Character := Default_Radix_Mark) |
| is |
| begin |
| Text_IO.Put (File, Image (Item, Pic, |
| Currency, Fill, Separator, Radix_Mark)); |
| end Put; |
| |
| procedure Put |
| (Item : in Num; |
| Pic : in Picture; |
| Currency : in String := Default_Currency; |
| Fill : in Character := Default_Fill; |
| Separator : in Character := Default_Separator; |
| Radix_Mark : in Character := Default_Radix_Mark) |
| is |
| begin |
| Text_IO.Put (Image (Item, Pic, |
| Currency, Fill, Separator, Radix_Mark)); |
| end Put; |
| |
| procedure Put |
| (To : out String; |
| Item : in Num; |
| Pic : in Picture; |
| Currency : in String := Default_Currency; |
| Fill : in Character := Default_Fill; |
| Separator : in Character := Default_Separator; |
| Radix_Mark : in Character := Default_Radix_Mark) |
| is |
| Result : constant String := |
| Image (Item, Pic, Currency, Fill, Separator, Radix_Mark); |
| |
| begin |
| if Result'Length > To'Length then |
| raise Ada.Text_IO.Layout_Error; |
| else |
| Strings_Fixed.Move (Source => Result, Target => To, |
| Justify => Strings.Right); |
| end if; |
| end Put; |
| |
| ----------- |
| -- Valid -- |
| ----------- |
| |
| function Valid |
| (Item : Num; |
| Pic : in Picture; |
| Currency : in String := Default_Currency) |
| return Boolean |
| is |
| begin |
| declare |
| Temp : constant String := Image (Item, Pic, Currency); |
| pragma Warnings (Off, Temp); |
| begin |
| return True; |
| end; |
| |
| exception |
| when Ada.Text_IO.Layout_Error => return False; |
| |
| end Valid; |
| end Decimal_Output; |
| |
| end Ada.Text_IO.Editing; |