gcc/ada/a-wtedit.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                        GNAT RUN-TIME COMPONENTS                          --
   4 --                                                                          --
   5 --             A D A . W I D E _ T E X T _ I O . E D I T I N G              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision: 1.1 $
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- As a special exception,  if other files  instantiate  generics from this --
  25 -- unit, or you link  this unit with other files  to produce an executable, --
  26 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27 -- covered  by the  GNU  General  Public  License.  This exception does not --
  28 -- however invalidate  any other reasons why  the executable file  might be --
  29 -- covered by the  GNU Public License.                                      --
  30 --                                                                          --
  31 -- GNAT was originally developed  by the GNAT team at  New York University. --
  32 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  33 --                                                                          --
  34 ------------------------------------------------------------------------------
  35
  36 with Ada.Strings.Fixed;
  37 with Ada.Strings.Wide_Fixed;
  38
  39 package body Ada.Wide_Text_IO.Editing is
  40
  41    package Strings            renames Ada.Strings;
  42    package Strings_Fixed      renames Ada.Strings.Fixed;
  43    package Strings_Wide_Fixed renames Ada.Strings.Wide_Fixed;
  44    package Wide_Text_IO       renames Ada.Wide_Text_IO;
  45
  46    -----------------------
  47    -- Local_Subprograms --
  48    -----------------------
  49
  50    function To_Wide (C : Character) return Wide_Character;
  51    pragma Inline (To_Wide);
  52    --  Convert Character to corresponding Wide_Character
  53
  54    ---------------------
  55    -- Blank_When_Zero --
  56    ---------------------
  57
  58    function Blank_When_Zero (Pic : in Picture) return Boolean is
  59    begin
  60       return Pic.Contents.Original_BWZ;
  61    end Blank_When_Zero;
  62
  63    --------------------
  64    -- Decimal_Output --
  65    --------------------
  66
  67    package body Decimal_Output is
  68
  69       -----------
  70       -- Image --
  71       -----------
  72
  73       function Image
  74         (Item       : in Num;
  75          Pic        : in Picture;
  76          Currency   : in Wide_String    := Default_Currency;
  77          Fill       : in Wide_Character := Default_Fill;
  78          Separator  : in Wide_Character := Default_Separator;
  79          Radix_Mark : in Wide_Character := Default_Radix_Mark)
  80          return       Wide_String
  81       is
  82       begin
  83          return Format_Number
  84             (Pic.Contents, Num'Image (Item),
  85              Currency, Fill, Separator, Radix_Mark);
  86       end Image;
  87
  88       ------------
  89       -- Length --
  90       ------------
  91
  92       function Length
  93         (Pic      : in Picture;
  94          Currency : in Wide_String := Default_Currency)
  95          return     Natural
  96       is
  97          Picstr     : constant String := Pic_String (Pic);
  98          V_Adjust   : Integer := 0;
  99          Cur_Adjust : Integer := 0;
 100
 101       begin
 102          --  Check if Picstr has 'V' or '$'
 103
 104          --  If 'V', then length is 1 less than otherwise
 105
 106          --  If '$', then length is Currency'Length-1 more than otherwise
 107
 108          --  This should use the string handling package ???
 109
 110          for J in Picstr'Range loop
 111             if Picstr (J) = 'V' then
 112                V_Adjust := -1;
 113
 114             elsif Picstr (J) = '$' then
 115                Cur_Adjust := Currency'Length - 1;
 116             end if;
 117          end loop;
 118
 119          return Picstr'Length - V_Adjust + Cur_Adjust;
 120       end Length;
 121
 122       ---------
 123       -- Put --
 124       ---------
 125
 126       procedure Put
 127         (File       : in Wide_Text_IO.File_Type;
 128          Item       : in Num;
 129          Pic        : in Picture;
 130          Currency   : in Wide_String    := Default_Currency;
 131          Fill       : in Wide_Character := Default_Fill;
 132          Separator  : in Wide_Character := Default_Separator;
 133          Radix_Mark : in Wide_Character := Default_Radix_Mark)
 134       is
 135       begin
 136          Wide_Text_IO.Put (File, Image (Item, Pic,
 137                                    Currency, Fill, Separator, Radix_Mark));
 138       end Put;
 139
 140       procedure Put
 141         (Item       : in Num;
 142          Pic        : in Picture;
 143          Currency   : in Wide_String    := Default_Currency;
 144          Fill       : in Wide_Character := Default_Fill;
 145          Separator  : in Wide_Character := Default_Separator;
 146          Radix_Mark : in Wide_Character := Default_Radix_Mark)
 147       is
 148       begin
 149          Wide_Text_IO.Put (Image (Item, Pic,
 150                              Currency, Fill, Separator, Radix_Mark));
 151       end Put;
 152
 153       procedure Put
 154         (To         : out Wide_String;
 155          Item       : in Num;
 156          Pic        : in Picture;
 157          Currency   : in Wide_String    := Default_Currency;
 158          Fill       : in Wide_Character := Default_Fill;
 159          Separator  : in Wide_Character := Default_Separator;
 160          Radix_Mark : in Wide_Character := Default_Radix_Mark)
 161       is
 162          Result : constant Wide_String :=
 163            Image (Item, Pic, Currency, Fill, Separator, Radix_Mark);
 164
 165       begin
 166          if Result'Length > To'Length then
 167             raise Wide_Text_IO.Layout_Error;
 168          else
 169             Strings_Wide_Fixed.Move (Source => Result, Target => To,
 170                                      Justify => Strings.Right);
 171          end if;
 172       end Put;
 173
 174       -----------
 175       -- Valid --
 176       -----------
 177
 178       function Valid
 179         (Item     : Num;
 180          Pic      : in Picture;
 181          Currency : in Wide_String := Default_Currency)
 182          return     Boolean
 183       is
 184       begin
 185          declare
 186             Temp : constant Wide_String := Image (Item, Pic, Currency);
 187             pragma Warnings (Off, Temp);
 188
 189          begin
 190             return True;
 191          end;
 192
 193       exception
 194          when Layout_Error => return False;
 195
 196       end Valid;
 197
 198    end Decimal_Output;
 199
 200    ------------
 201    -- Expand --
 202    ------------
 203
 204    function Expand (Picture : in String) return String is
 205       Result        : String (1 .. MAX_PICSIZE);
 206       Picture_Index : Integer := Picture'First;
 207       Result_Index  : Integer := Result'First;
 208       Count         : Natural;
 209       Last          : Integer;
 210
 211    begin
 212       if Picture'Length < 1 then
 213          raise Picture_Error;
 214       end if;
 215
 216       if Picture (Picture'First) = '(' then
 217          raise Picture_Error;
 218       end if;
 219
 220       loop
 221          case Picture (Picture_Index) is
 222
 223             when '(' =>
 224
 225                --  We now need to scan out the count after a left paren.
 226                --  In the non-wide version we used Integer_IO.Get, but
 227                --  that is not convenient here, since we don't want to
 228                --  drag in normal Text_IO just for this purpose. So we
 229                --  do the scan ourselves, with the normal validity checks.
 230
 231                Last := Picture_Index + 1;
 232                Count := 0;
 233
 234                if Picture (Last) not in '0' .. '9' then
 235                   raise Picture_Error;
 236                end if;
 237
 238                Count := Character'Pos (Picture (Last)) - Character'Pos ('0');
 239                Last := Last + 1;
 240
 241                loop
 242                   if Last > Picture'Last then
 243                      raise Picture_Error;
 244                   end if;
 245
 246                   if Picture (Last) = '_' then
 247                      if Picture (Last - 1) = '_' then
 248                         raise Picture_Error;
 249                      end if;
 250
 251                   elsif Picture (Last) = ')' then
 252                      exit;
 253
 254                   elsif Picture (Last) not in '0' .. '9' then
 255                      raise Picture_Error;
 256
 257                   else
 258                      Count := Count * 10
 259                                 +  Character'Pos (Picture (Last)) -
 260                                    Character'Pos ('0');
 261                   end if;
 262
 263                   Last := Last + 1;
 264                end loop;
 265
 266                --  In what follows note that one copy of the repeated
 267                --  character has already been made, so a count of one is a
 268                --  no-op, and a count of zero erases a character.
 269
 270                for J in 2 .. Count loop
 271                   Result (Result_Index + J - 2) := Picture (Picture_Index - 1);
 272                end loop;
 273
 274                Result_Index := Result_Index + Count - 1;
 275
 276                --  Last was a ')' throw it away too.
 277
 278                Picture_Index := Last + 1;
 279
 280             when ')' =>
 281                raise Picture_Error;
 282
 283             when others =>
 284                Result (Result_Index) := Picture (Picture_Index);
 285                Picture_Index := Picture_Index + 1;
 286                Result_Index := Result_Index + 1;
 287
 288          end case;
 289
 290          exit when Picture_Index > Picture'Last;
 291       end loop;
 292
 293       return Result (1 .. Result_Index - 1);
 294
 295    exception
 296       when others =>
 297          raise Picture_Error;
 298
 299    end Expand;
 300
 301    -------------------
 302    -- Format_Number --
 303    -------------------
 304
 305    function Format_Number
 306      (Pic                 : Format_Record;
 307       Number              : String;
 308       Currency_Symbol     : Wide_String;
 309       Fill_Character      : Wide_Character;
 310       Separator_Character : Wide_Character;
 311       Radix_Point         : Wide_Character)
 312       return                Wide_String
 313    is
 314       Attrs    : Number_Attributes := Parse_Number_String (Number);
 315       Position : Integer;
 316       Rounded  : String := Number;
 317
 318       Sign_Position : Integer := Pic.Sign_Position; --  may float.
 319
 320       Answer        : Wide_String (1 .. Pic.Picture.Length);
 321       Last          : Integer;
 322       Currency_Pos  : Integer := Pic.Start_Currency;
 323
 324       Dollar : Boolean := False;
 325       --  Overridden immediately if necessary.
 326
 327       Zero : Boolean := True;
 328       --  Set to False when a non-zero digit is output.
 329
 330    begin
 331
 332       --  If the picture has fewer decimal places than the number, the image
 333       --  must be rounded according to the usual rules.
 334
 335       if Attrs.Has_Fraction then
 336          declare
 337             R : constant Integer :=
 338               (Attrs.End_Of_Fraction - Attrs.Start_Of_Fraction + 1)
 339                 - Pic.Max_Trailing_Digits;
 340             R_Pos : Integer;
 341
 342          begin
 343             if R > 0 then
 344                R_Pos := Rounded'Length - R;
 345
 346                if Rounded (R_Pos + 1) > '4' then
 347
 348                   if Rounded (R_Pos) = '.' then
 349                      R_Pos := R_Pos - 1;
 350                   end if;
 351
 352                   if Rounded (R_Pos) /= '9' then
 353                      Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
 354                   else
 355                      Rounded (R_Pos) := '0';
 356                      R_Pos := R_Pos - 1;
 357
 358                      while R_Pos > 1 loop
 359                         if Rounded (R_Pos) = '.' then
 360                            R_Pos := R_Pos - 1;
 361                         end if;
 362
 363                         if Rounded (R_Pos) /= '9' then
 364                            Rounded (R_Pos) := Character'Succ (Rounded (R_Pos));
 365                            exit;
 366                         else
 367                            Rounded (R_Pos) := '0';
 368                            R_Pos := R_Pos - 1;
 369                         end if;
 370                      end loop;
 371
 372                      --  The rounding may add a digit in front. Either the
 373                      --  leading blank or the sign (already captured) can
 374                      --  be overwritten.
 375
 376                      if R_Pos = 1 then
 377                         Rounded (R_Pos) := '1';
 378                         Attrs.Start_Of_Int := Attrs.Start_Of_Int - 1;
 379                      end if;
 380                   end if;
 381                end if;
 382             end if;
 383          end;
 384       end if;
 385
 386       for J in Answer'Range loop
 387          Answer (J) := To_Wide (Pic.Picture.Expanded (J));
 388       end loop;
 389
 390       if Pic.Start_Currency /= Invalid_Position then
 391          Dollar := Answer (Pic.Start_Currency) = '$';
 392       end if;
 393
 394       --  Fix up "direct inserts" outside the playing field. Set up as one
 395       --  loop to do the beginning, one (reverse) loop to do the end.
 396
 397       Last := 1;
 398       loop
 399          exit when Last = Pic.Start_Float;
 400          exit when Last = Pic.Radix_Position;
 401          exit when Answer (Last) = '9';
 402
 403          case Answer (Last) is
 404
 405             when '_' =>
 406                Answer (Last) := Separator_Character;
 407
 408             when 'b' =>
 409                Answer (Last) := ' ';
 410
 411             when others =>
 412                null;
 413
 414          end case;
 415
 416          exit when Last = Answer'Last;
 417
 418          Last := Last + 1;
 419       end loop;
 420
 421       --  Now for the end...
 422
 423       for J in reverse Last .. Answer'Last loop
 424          exit when J = Pic.Radix_Position;
 425
 426          --  Do this test First, Separator_Character can equal Pic.Floater.
 427
 428          if Answer (J) = Pic.Floater then
 429             exit;
 430          end if;
 431
 432          case Answer (J) is
 433
 434             when '_' =>
 435                Answer (J) := Separator_Character;
 436
 437             when 'b' =>
 438                Answer (J) := ' ';
 439
 440             when '9' =>
 441                exit;
 442
 443             when others =>
 444                null;
 445
 446          end case;
 447       end loop;
 448
 449       --  Non-floating sign
 450
 451       if Pic.Start_Currency /= -1
 452         and then Answer (Pic.Start_Currency) = '#'
 453         and then Pic.Floater /= '#'
 454       then
 455          if Currency_Symbol'Length >
 456             Pic.End_Currency - Pic.Start_Currency + 1
 457          then
 458             raise Picture_Error;
 459
 460          elsif Currency_Symbol'Length =
 461             Pic.End_Currency - Pic.Start_Currency + 1
 462          then
 463             Answer (Pic.Start_Currency .. Pic.End_Currency) :=
 464               Currency_Symbol;
 465
 466          elsif Pic.Radix_Position = Invalid_Position
 467            or else Pic.Start_Currency < Pic.Radix_Position
 468          then
 469             Answer (Pic.Start_Currency .. Pic.End_Currency) :=
 470                                                         (others => ' ');
 471             Answer (Pic.End_Currency - Currency_Symbol'Length + 1 ..
 472                     Pic.End_Currency) := Currency_Symbol;
 473
 474          else
 475             Answer (Pic.Start_Currency .. Pic.End_Currency) :=
 476                                                         (others => ' ');
 477             Answer (Pic.Start_Currency ..
 478                     Pic.Start_Currency + Currency_Symbol'Length - 1) :=
 479                                                         Currency_Symbol;
 480          end if;
 481       end if;
 482
 483       --  Fill in leading digits
 484
 485       if Attrs.End_Of_Int - Attrs.Start_Of_Int + 1 >
 486                                                 Pic.Max_Leading_Digits
 487       then
 488          raise Layout_Error;
 489       end if;
 490
 491       if Pic.Radix_Position = Invalid_Position then
 492          Position := Answer'Last;
 493       else
 494          Position := Pic.Radix_Position - 1;
 495       end if;
 496
 497       for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
 498
 499          while Answer (Position) /= '9'
 500            and Answer (Position) /= Pic.Floater
 501          loop
 502             if Answer (Position) = '_' then
 503                Answer (Position) := Separator_Character;
 504
 505             elsif Answer (Position) = 'b' then
 506                Answer (Position) := ' ';
 507             end if;
 508
 509             Position := Position - 1;
 510          end loop;
 511
 512          Answer (Position) := To_Wide (Rounded (J));
 513
 514          if Rounded (J) /= '0' then
 515             Zero := False;
 516          end if;
 517
 518          Position := Position - 1;
 519       end loop;
 520
 521       --  Do lead float
 522
 523       if Pic.Start_Float = Invalid_Position then
 524
 525          --  No leading floats, but need to change '9' to '0', '_' to
 526          --  Separator_Character and 'b' to ' '.
 527
 528          for J in Last .. Position loop
 529
 530             --  Last set when fixing the "uninteresting" leaders above.
 531             --  Don't duplicate the work.
 532
 533             if Answer (J) = '9' then
 534                Answer (J) := '0';
 535
 536             elsif Answer (J) = '_' then
 537                Answer (J) := Separator_Character;
 538
 539             elsif Answer (J) = 'b' then
 540                Answer (J) := ' ';
 541
 542             end if;
 543
 544          end loop;
 545
 546       elsif Pic.Floater = '<'
 547               or else
 548             Pic.Floater = '+'
 549               or else
 550             Pic.Floater = '-'
 551       then
 552          for J in Pic.End_Float .. Position loop --  May be null range.
 553             if Answer (J) = '9' then
 554                Answer (J) := '0';
 555
 556             elsif Answer (J) = '_' then
 557                Answer (J) := Separator_Character;
 558
 559             elsif Answer (J) = 'b' then
 560                Answer (J) := ' ';
 561
 562             end if;
 563          end loop;
 564
 565          if Position > Pic.End_Float then
 566             Position := Pic.End_Float;
 567          end if;
 568
 569          for J in Pic.Start_Float .. Position - 1 loop
 570             Answer (J) := ' ';
 571          end loop;
 572
 573          Answer (Position) := Pic.Floater;
 574          Sign_Position     := Position;
 575
 576       elsif Pic.Floater = '$' then
 577
 578          for J in Pic.End_Float .. Position loop --  May be null range.
 579             if Answer (J) = '9' then
 580                Answer (J) := '0';
 581
 582             elsif Answer (J) = '_' then
 583                Answer (J) := ' ';   --  no separator before leftmost digit.
 584
 585             elsif Answer (J) = 'b' then
 586                Answer (J) := ' ';
 587             end if;
 588          end loop;
 589
 590          if Position > Pic.End_Float then
 591             Position := Pic.End_Float;
 592          end if;
 593
 594          for J in Pic.Start_Float .. Position - 1 loop
 595             Answer (J) := ' ';
 596          end loop;
 597
 598          Answer (Position) := Pic.Floater;
 599          Currency_Pos      := Position;
 600
 601       elsif Pic.Floater = '*' then
 602
 603          for J in Pic.End_Float .. Position loop --  May be null range.
 604             if Answer (J) = '9' then
 605                Answer (J) := '0';
 606
 607             elsif Answer (J) = '_' then
 608                Answer (J) := Separator_Character;
 609
 610             elsif Answer (J) = 'b' then
 611                Answer (J) := '*';
 612             end if;
 613          end loop;
 614
 615          if Position > Pic.End_Float then
 616             Position := Pic.End_Float;
 617          end if;
 618
 619          for J in Pic.Start_Float .. Position loop
 620             Answer (J) := '*';
 621          end loop;
 622
 623       else
 624          if Pic.Floater = '#' then
 625             Currency_Pos := Currency_Symbol'Length;
 626          end if;
 627
 628          for J in reverse Pic.Start_Float .. Position loop
 629             case Answer (J) is
 630
 631                when '*' =>
 632                   Answer (J) := Fill_Character;
 633
 634                when 'Z' | 'b' | '/' | '0' =>
 635                   Answer (J) := ' ';
 636
 637                when '9' =>
 638                   Answer (J) := '0';
 639
 640                when '.' | 'V' | 'v' | '<' | '$' | '+' | '-' =>
 641                   null;
 642
 643                when '#' =>
 644                   if Currency_Pos = 0 then
 645                      Answer (J) := ' ';
 646                   else
 647                      Answer (J)   := Currency_Symbol (Currency_Pos);
 648                      Currency_Pos := Currency_Pos - 1;
 649                   end if;
 650
 651                when '_' =>
 652
 653                   case Pic.Floater is
 654
 655                      when '*' =>
 656                         Answer (J) := Fill_Character;
 657
 658                      when 'Z' | 'b' =>
 659                         Answer (J) := ' ';
 660
 661                      when '#' =>
 662                         if Currency_Pos = 0 then
 663                            Answer (J) := ' ';
 664
 665                         else
 666                            Answer (J)   := Currency_Symbol (Currency_Pos);
 667                            Currency_Pos := Currency_Pos - 1;
 668                         end if;
 669
 670                      when others =>
 671                         null;
 672
 673                   end case;
 674
 675                when others =>
 676                   null;
 677
 678             end case;
 679          end loop;
 680
 681          if Pic.Floater = '#' and then Currency_Pos /= 0 then
 682             raise Layout_Error;
 683          end if;
 684       end if;
 685
 686       --  Do sign
 687
 688       if Sign_Position = Invalid_Position then
 689          if Attrs.Negative then
 690             raise Layout_Error;
 691          end if;
 692
 693       else
 694          if Attrs.Negative then
 695             case Answer (Sign_Position) is
 696                when 'C' | 'D' | '-' =>
 697                   null;
 698
 699                when '+' =>
 700                   Answer (Sign_Position) := '-';
 701
 702                when '<' =>
 703                   Answer (Sign_Position)   := '(';
 704                   Answer (Pic.Second_Sign) := ')';
 705
 706                when others =>
 707                   raise Picture_Error;
 708
 709             end case;
 710
 711          else --  positive
 712
 713             case Answer (Sign_Position) is
 714
 715                when '-' =>
 716                   Answer (Sign_Position) := ' ';
 717
 718                when '<' | 'C' | 'D' =>
 719                   Answer (Sign_Position)   := ' ';
 720                   Answer (Pic.Second_Sign) := ' ';
 721
 722                when '+' =>
 723                   null;
 724
 725                when others =>
 726                   raise Picture_Error;
 727
 728             end case;
 729          end if;
 730       end if;
 731
 732       --  Fill in trailing digits
 733
 734       if Pic.Max_Trailing_Digits > 0 then
 735
 736          if Attrs.Has_Fraction then
 737             Position := Attrs.Start_Of_Fraction;
 738             Last     := Pic.Radix_Position + 1;
 739
 740             for J in Last .. Answer'Last loop
 741
 742                if Answer (J) = '9' or Answer (J) = Pic.Floater then
 743                   Answer (J) := To_Wide (Rounded (Position));
 744
 745                   if Rounded (Position) /= '0' then
 746                      Zero := False;
 747                   end if;
 748
 749                   Position := Position + 1;
 750                   Last     := J + 1;
 751
 752                   --  Used up fraction but remember place in Answer
 753
 754                   exit when Position > Attrs.End_Of_Fraction;
 755
 756                elsif Answer (J) = 'b' then
 757                   Answer (J) := ' ';
 758
 759                elsif Answer (J) = '_' then
 760                   Answer (J) := Separator_Character;
 761
 762                end if;
 763
 764                Last := J + 1;
 765             end loop;
 766
 767             Position := Last;
 768
 769          else
 770             Position := Pic.Radix_Position + 1;
 771          end if;
 772
 773          --  Now fill remaining 9's with zeros and _ with separators
 774
 775          Last := Answer'Last;
 776
 777          for J in Position .. Last loop
 778             if Answer (J) = '9' then
 779                Answer (J) := '0';
 780
 781             elsif Answer (J) = Pic.Floater then
 782                Answer (J) := '0';
 783
 784             elsif Answer (J) = '_' then
 785                Answer (J) := Separator_Character;
 786
 787             elsif Answer (J) = 'b' then
 788                Answer (J) := ' ';
 789
 790             end if;
 791          end loop;
 792
 793          Position := Last + 1;
 794
 795       else
 796          if Pic.Floater = '#' and then Currency_Pos /= 0 then
 797             raise Layout_Error;
 798          end if;
 799
 800          --  No trailing digits, but now J may need to stick in a currency
 801          --  symbol or sign.
 802
 803          if Pic.Start_Currency = Invalid_Position then
 804             Position := Answer'Last + 1;
 805          else
 806             Position := Pic.Start_Currency;
 807          end if;
 808       end if;
 809
 810       for J in Position .. Answer'Last loop
 811
 812          if Pic.Start_Currency /= Invalid_Position and then
 813             Answer (Pic.Start_Currency) = '#' then
 814             Currency_Pos := 1;
 815          end if;
 816
 817          --  Note: There are some weird cases J can imagine with 'b' or '#'
 818          --  in currency strings where the following code will cause
 819          --  glitches. The trick is to tell when the character in the
 820          --  answer should be checked, and when to look at the original
 821          --  string. Some other time. RIE 11/26/96 ???
 822
 823          case Answer (J) is
 824             when '*' =>
 825                Answer (J) := Fill_Character;
 826
 827             when 'b' =>
 828                Answer (J) := ' ';
 829
 830             when '#' =>
 831                if Currency_Pos > Currency_Symbol'Length then
 832                   Answer (J) := ' ';
 833
 834                else
 835                   Answer (J)   := Currency_Symbol (Currency_Pos);
 836                   Currency_Pos := Currency_Pos + 1;
 837                end if;
 838
 839             when '_' =>
 840
 841                case Pic.Floater is
 842
 843                   when '*' =>
 844                      Answer (J) := Fill_Character;
 845
 846                   when 'Z' | 'z' =>
 847                      Answer (J) := ' ';
 848
 849                   when '#' =>
 850                      if Currency_Pos > Currency_Symbol'Length then
 851                         Answer (J) := ' ';
 852                      else
 853                         Answer (J)   := Currency_Symbol (Currency_Pos);
 854                         Currency_Pos := Currency_Pos + 1;
 855                      end if;
 856
 857                   when others =>
 858                      null;
 859
 860                end case;
 861
 862             when others =>
 863                exit;
 864
 865          end case;
 866       end loop;
 867
 868       --  Now get rid of Blank_when_Zero and complete Star fill.
 869
 870       if Zero and Pic.Blank_When_Zero then
 871
 872          --  Value is zero, and blank it.
 873
 874          Last := Answer'Last;
 875
 876          if Dollar then
 877             Last := Last - 1 + Currency_Symbol'Length;
 878          end if;
 879
 880          if Pic.Radix_Position /= Invalid_Position and then
 881             Answer (Pic.Radix_Position) = 'V' then
 882             Last := Last - 1;
 883          end if;
 884
 885          return Wide_String'(1 .. Last => ' ');
 886
 887       elsif Zero and Pic.Star_Fill then
 888          Last := Answer'Last;
 889
 890          if Dollar then
 891             Last := Last - 1 + Currency_Symbol'Length;
 892          end if;
 893
 894          if Pic.Radix_Position /= Invalid_Position then
 895
 896             if Answer (Pic.Radix_Position) = 'V' then
 897                Last := Last - 1;
 898
 899             elsif Dollar then
 900                if Pic.Radix_Position > Pic.Start_Currency then
 901                   return Wide_String' (1 .. Pic.Radix_Position - 1 => '*') &
 902                      Radix_Point &
 903                      Wide_String' (Pic.Radix_Position + 1 .. Last => '*');
 904
 905                else
 906                   return
 907                      Wide_String'
 908                      (1 ..
 909                       Pic.Radix_Position + Currency_Symbol'Length - 2
 910                                              => '*') &
 911                      Radix_Point &
 912                      Wide_String'
 913                        (Pic.Radix_Position + Currency_Symbol'Length .. Last
 914                                              => '*');
 915                end if;
 916
 917             else
 918                return
 919                  Wide_String'(1 .. Pic.Radix_Position - 1 => '*') &
 920                  Radix_Point &
 921                  Wide_String'(Pic.Radix_Position + 1 .. Last => '*');
 922             end if;
 923          end if;
 924
 925          return Wide_String' (1 .. Last => '*');
 926       end if;
 927
 928       --  This was once a simple return statement, now there are nine
 929       --  different return cases.  Not to mention the five above to deal
 930       --  with zeros.  Why not split things out?
 931
 932       --  Processing the radix and sign expansion separately
 933       --  would require lots of copying--the string and some of its
 934       --  indices--without really simplifying the logic.  The cases are:
 935
 936       --  1) Expand $, replace '.' with Radix_Point
 937       --  2) No currency expansion, replace '.' with Radix_Point
 938       --  3) Expand $, radix blanked
 939       --  4) No currency expansion, radix blanked
 940       --  5) Elide V
 941       --  6) Expand $, Elide V
 942       --  7) Elide V, Expand $ (Two cases depending on order.)
 943       --  8) No radix, expand $
 944       --  9) No radix, no currency expansion
 945
 946       if Pic.Radix_Position /= Invalid_Position then
 947
 948          if Answer (Pic.Radix_Position) = '.' then
 949             Answer (Pic.Radix_Position) := Radix_Point;
 950
 951             if Dollar then
 952
 953                --  1) Expand $, replace '.' with Radix_Point
 954
 955                return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
 956                   Answer (Currency_Pos + 1 .. Answer'Last);
 957
 958             else
 959                --  2) No currency expansion, replace '.' with Radix_Point
 960
 961                return Answer;
 962             end if;
 963
 964          elsif Answer (Pic.Radix_Position) = ' ' then --  blanked radix.
 965             if Dollar then
 966
 967                --  3) Expand $, radix blanked
 968
 969                return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
 970                  Answer (Currency_Pos + 1 .. Answer'Last);
 971
 972             else
 973                --  4) No expansion, radix blanked
 974
 975                return Answer;
 976             end if;
 977
 978          --  V cases
 979
 980          else
 981             if not Dollar then
 982
 983                --  5) Elide V
 984
 985                return Answer (1 .. Pic.Radix_Position - 1) &
 986                   Answer (Pic.Radix_Position + 1 .. Answer'Last);
 987
 988             elsif Currency_Pos < Pic.Radix_Position then
 989
 990                --  6) Expand $, Elide V
 991
 992                return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
 993                   Answer (Currency_Pos + 1 .. Pic.Radix_Position - 1) &
 994                   Answer (Pic.Radix_Position + 1 .. Answer'Last);
 995
 996             else
 997                --  7) Elide V, Expand $
 998
 999                return Answer (1 .. Pic.Radix_Position - 1) &
1000                   Answer (Pic.Radix_Position + 1 .. Currency_Pos - 1) &
1001                   Currency_Symbol &
1002                   Answer (Currency_Pos + 1 .. Answer'Last);
1003             end if;
1004          end if;
1005
1006       elsif Dollar then
1007
1008          --  8) No radix, expand $
1009
1010          return Answer (1 .. Currency_Pos - 1) & Currency_Symbol &
1011             Answer (Currency_Pos + 1 .. Answer'Last);
1012
1013       else
1014          --  9) No radix, no currency expansion
1015
1016          return Answer;
1017       end if;
1018
1019    end Format_Number;
1020
1021    -------------------------
1022    -- Parse_Number_String --
1023    -------------------------
1024
1025    function Parse_Number_String (Str : String) return Number_Attributes is
1026       Answer : Number_Attributes;
1027
1028    begin
1029       for J in Str'Range loop
1030          case Str (J) is
1031
1032             when ' ' =>
1033                null; --  ignore
1034
1035             when '1' .. '9' =>
1036
1037                --  Decide if this is the start of a number.
1038                --  If so, figure out which one...
1039
1040                if Answer.Has_Fraction then
1041                   Answer.End_Of_Fraction := J;
1042                else
1043                   if Answer.Start_Of_Int = Invalid_Position then
1044                      --  start integer
1045                      Answer.Start_Of_Int := J;
1046                   end if;
1047                   Answer.End_Of_Int := J;
1048                end if;
1049
1050             when '0' =>
1051
1052                --  Only count a zero before the decimal point if it follows a
1053                --  non-zero digit.  After the decimal point, zeros will be
1054                --  counted if followed by a non-zero digit.
1055
1056                if not Answer.Has_Fraction then
1057                   if Answer.Start_Of_Int /= Invalid_Position then
1058                      Answer.End_Of_Int := J;
1059                   end if;
1060                end if;
1061
1062             when '-' =>
1063
1064                --  Set negative
1065
1066                Answer.Negative := True;
1067
1068             when '.' =>
1069
1070                --  Close integer, start fraction
1071
1072                if Answer.Has_Fraction then
1073                   raise Picture_Error;
1074                end if;
1075
1076                --  Two decimal points is a no-no.
1077
1078                Answer.Has_Fraction    := True;
1079                Answer.End_Of_Fraction := J;
1080
1081                --  Could leave this at Invalid_Position, but this seems the
1082                --  right way to indicate a null range...
1083
1084                Answer.Start_Of_Fraction := J + 1;
1085                Answer.End_Of_Int        := J - 1;
1086
1087             when others =>
1088                raise Picture_Error; -- can this happen? probably not!
1089          end case;
1090       end loop;
1091
1092       if Answer.Start_Of_Int = Invalid_Position then
1093          Answer.Start_Of_Int := Answer.End_Of_Int + 1;
1094       end if;
1095
1096       --  No significant (intger) digits needs a null range.
1097
1098       return Answer;
1099
1100    end Parse_Number_String;
1101
1102    ----------------
1103    -- Pic_String --
1104    ----------------
1105
1106    --  The following ensures that we return B and not b being careful not
1107    --  to break things which expect lower case b for blank. See CXF3A02.
1108
1109    function Pic_String (Pic : in Picture) return String is
1110       Temp : String (1 .. Pic.Contents.Picture.Length) :=
1111                               Pic.Contents.Picture.Expanded;
1112    begin
1113       for J in Temp'Range loop
1114          if Temp (J) = 'b' then Temp (J) := 'B'; end if;
1115       end loop;
1116
1117       return Temp;
1118    end Pic_String;
1119
1120    ------------------
1121    -- Precalculate --
1122    ------------------
1123
1124    procedure Precalculate  (Pic : in out Format_Record) is
1125
1126       Computed_BWZ : Boolean := True;
1127
1128       type Legality is  (Okay, Reject);
1129       State : Legality := Reject;
1130       --  Start in reject, which will reject null strings.
1131
1132       Index : Pic_Index := Pic.Picture.Expanded'First;
1133
1134       function At_End return Boolean;
1135       pragma Inline (At_End);
1136
1137       procedure Set_State (L : Legality);
1138       pragma Inline (Set_State);
1139
1140       function Look return Character;
1141       pragma Inline (Look);
1142
1143       function Is_Insert return Boolean;
1144       pragma Inline (Is_Insert);
1145
1146       procedure Skip;
1147       pragma Inline (Skip);
1148
1149       procedure Trailing_Currency;
1150       procedure Trailing_Bracket;
1151       procedure Number_Fraction;
1152       procedure Number_Completion;
1153       procedure Number_Fraction_Or_Bracket;
1154       procedure Number_Fraction_Or_Z_Fill;
1155       procedure Zero_Suppression;
1156       procedure Floating_Bracket;
1157       procedure Number_Fraction_Or_Star_Fill;
1158       procedure Star_Suppression;
1159       procedure Number_Fraction_Or_Dollar;
1160       procedure Leading_Dollar;
1161       procedure Number_Fraction_Or_Pound;
1162       procedure Leading_Pound;
1163       procedure Picture;
1164       procedure Floating_Plus;
1165       procedure Floating_Minus;
1166       procedure Picture_Plus;
1167       procedure Picture_Minus;
1168       procedure Picture_Bracket;
1169       procedure Number;
1170       procedure Optional_RHS_Sign;
1171       procedure Picture_String;
1172
1173       ------------
1174       -- At_End --
1175       ------------
1176
1177       function At_End return Boolean is
1178       begin
1179          return Index > Pic.Picture.Length;
1180       end At_End;
1181
1182       ----------------------
1183       -- Floating_Bracket --
1184       ----------------------
1185
1186       --  Note that Floating_Bracket is only called with an acceptable
1187       --  prefix. But we don't set Okay, because we must end with a '>'.
1188
1189       procedure Floating_Bracket is
1190       begin
1191          Pic.Floater := '<';
1192          Pic.End_Float := Index;
1193          Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1194
1195          --  First bracket wasn't counted...
1196
1197          Skip; --  known '<'
1198
1199          loop
1200             if At_End then
1201                return;
1202             end if;
1203
1204             case Look is
1205
1206                when '_' | '0' | '/' =>
1207                   Pic.End_Float := Index;
1208                   Skip;
1209
1210                when 'B' | 'b'  =>
1211                   Pic.End_Float := Index;
1212                   Pic.Picture.Expanded (Index) := 'b';
1213                   Skip;
1214
1215                when '<' =>
1216                   Pic.End_Float := Index;
1217                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1218                   Skip;
1219
1220                when '9' =>
1221                   Number_Completion;
1222
1223                when '$' =>
1224                   Leading_Dollar;
1225
1226                when '#' =>
1227                   Leading_Pound;
1228
1229                when 'V' | 'v' | '.' =>
1230                   Pic.Radix_Position := Index;
1231                   Skip;
1232                   Number_Fraction_Or_Bracket;
1233                   return;
1234
1235                when others =>
1236                return;
1237             end case;
1238          end loop;
1239       end Floating_Bracket;
1240
1241       --------------------
1242       -- Floating_Minus --
1243       --------------------
1244
1245       procedure Floating_Minus is
1246       begin
1247          loop
1248             if At_End then
1249                return;
1250             end if;
1251
1252             case Look is
1253                when '_' | '0' | '/' =>
1254                   Pic.End_Float := Index;
1255                   Skip;
1256
1257                when 'B' | 'b'  =>
1258                   Pic.End_Float := Index;
1259                   Pic.Picture.Expanded (Index) := 'b';
1260                   Skip;
1261
1262                when '-' =>
1263                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1264                   Pic.End_Float := Index;
1265                   Skip;
1266
1267                when '9' =>
1268                   Number_Completion;
1269                   return;
1270
1271                when '.' | 'V' | 'v' =>
1272                   Pic.Radix_Position := Index;
1273                   Skip; --  Radix
1274
1275                   while Is_Insert loop
1276                      Skip;
1277                   end loop;
1278
1279                   if At_End then
1280                      return;
1281                   end if;
1282
1283                   if Look = '-' then
1284                      loop
1285                         if At_End then
1286                            return;
1287                         end if;
1288
1289                         case Look is
1290
1291                            when '-' =>
1292                               Pic.Max_Trailing_Digits :=
1293                                 Pic.Max_Trailing_Digits + 1;
1294                               Pic.End_Float := Index;
1295                               Skip;
1296
1297                            when '_' | '0' | '/' =>
1298                               Skip;
1299
1300                            when 'B' | 'b'  =>
1301                               Pic.Picture.Expanded (Index) := 'b';
1302                               Skip;
1303
1304                            when others =>
1305                               return;
1306
1307                         end case;
1308                      end loop;
1309
1310                   else
1311                      Number_Completion;
1312                   end if;
1313
1314                   return;
1315
1316                when others =>
1317                   return;
1318             end case;
1319          end loop;
1320       end Floating_Minus;
1321
1322       -------------------
1323       -- Floating_Plus --
1324       -------------------
1325
1326       procedure Floating_Plus is
1327       begin
1328          loop
1329             if At_End then
1330                return;
1331             end if;
1332
1333             case Look is
1334                when '_' | '0' | '/' =>
1335                   Pic.End_Float := Index;
1336                   Skip;
1337
1338                when 'B' | 'b'  =>
1339                   Pic.End_Float := Index;
1340                   Pic.Picture.Expanded (Index) := 'b';
1341                   Skip;
1342
1343                when '+' =>
1344                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1345                   Pic.End_Float := Index;
1346                   Skip;
1347
1348                when '9' =>
1349                   Number_Completion;
1350                   return;
1351
1352                when '.' | 'V' | 'v' =>
1353                   Pic.Radix_Position := Index;
1354                   Skip; --  Radix
1355
1356                   while Is_Insert loop
1357                      Skip;
1358                   end loop;
1359
1360                   if At_End then
1361                      return;
1362                   end if;
1363
1364                   if Look = '+' then
1365                      loop
1366                         if At_End then
1367                            return;
1368                         end if;
1369
1370                         case Look is
1371
1372                            when '+' =>
1373                               Pic.Max_Trailing_Digits :=
1374                                 Pic.Max_Trailing_Digits + 1;
1375                               Pic.End_Float := Index;
1376                               Skip;
1377
1378                            when '_' | '0' | '/' =>
1379                               Skip;
1380
1381                            when 'B' | 'b'  =>
1382                               Pic.Picture.Expanded (Index) := 'b';
1383                               Skip;
1384
1385                            when others =>
1386                               return;
1387
1388                         end case;
1389                      end loop;
1390
1391                   else
1392                      Number_Completion;
1393                   end if;
1394
1395                   return;
1396
1397                when others =>
1398                   return;
1399
1400             end case;
1401          end loop;
1402       end Floating_Plus;
1403
1404       ---------------
1405       -- Is_Insert --
1406       ---------------
1407
1408       function Is_Insert return Boolean is
1409       begin
1410          if At_End then
1411             return False;
1412          end if;
1413
1414          case Pic.Picture.Expanded (Index) is
1415
1416             when '_' | '0' | '/' => return True;
1417
1418             when 'B' | 'b' =>
1419                Pic.Picture.Expanded (Index) := 'b'; --  canonical
1420                return True;
1421
1422             when others => return False;
1423          end case;
1424       end Is_Insert;
1425
1426       --------------------
1427       -- Leading_Dollar --
1428       --------------------
1429
1430       --  Note that Leading_Dollar can be called in either State.
1431       --  It will set state to Okay only if a 9 or (second) $
1432       --  is encountered.
1433
1434       --  Also notice the tricky bit with State and Zero_Suppression.
1435       --  Zero_Suppression is Picture_Error if a '$' or a '9' has been
1436       --  encountered, exactly the cases where State has been set.
1437
1438       procedure Leading_Dollar is
1439       begin
1440          --  Treat as a floating dollar, and unwind otherwise.
1441
1442          Pic.Floater := '$';
1443          Pic.Start_Currency := Index;
1444          Pic.End_Currency := Index;
1445          Pic.Start_Float := Index;
1446          Pic.End_Float := Index;
1447
1448          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
1449          --  currency place.
1450
1451          Skip; --  known '$'
1452
1453          loop
1454             if At_End then
1455                return;
1456             end if;
1457
1458             case Look is
1459
1460                when '_' | '0' | '/' =>
1461                   Pic.End_Float := Index;
1462                   Skip;
1463
1464                   --  A trailing insertion character is not part of the
1465                   --  floating currency, so need to look ahead.
1466
1467                   if Look /= '$' then
1468                      Pic.End_Float := Pic.End_Float - 1;
1469                   end if;
1470
1471                when 'B' | 'b'  =>
1472                   Pic.End_Float := Index;
1473                   Pic.Picture.Expanded (Index) := 'b';
1474                   Skip;
1475
1476                when 'Z' | 'z' =>
1477                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1478
1479                   if State = Okay then
1480                      raise Picture_Error;
1481                   else
1482                      --  Will overwrite Floater and Start_Float
1483
1484                      Zero_Suppression;
1485                   end if;
1486
1487                when '*' =>
1488                   if State = Okay then
1489                      raise Picture_Error;
1490                   else
1491                      --  Will overwrite Floater and Start_Float
1492
1493                      Star_Suppression;
1494                   end if;
1495
1496                when '$' =>
1497                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1498                   Pic.End_Float := Index;
1499                   Pic.End_Currency := Index;
1500                   Set_State (Okay); Skip;
1501
1502                when '9' =>
1503                   if State /= Okay then
1504                      Pic.Floater := '!';
1505                      Pic.Start_Float := Invalid_Position;
1506                      Pic.End_Float := Invalid_Position;
1507                   end if;
1508
1509                   --  A single dollar does not a floating make.
1510
1511                   Number_Completion;
1512                   return;
1513
1514                when 'V' | 'v' | '.' =>
1515                   if State /= Okay then
1516                      Pic.Floater := '!';
1517                      Pic.Start_Float := Invalid_Position;
1518                      Pic.End_Float := Invalid_Position;
1519                   end if;
1520
1521                   --  Only one dollar before the sign is okay,
1522                   --  but doesn't float.
1523
1524                   Pic.Radix_Position := Index;
1525                   Skip;
1526                   Number_Fraction_Or_Dollar;
1527                   return;
1528
1529                when others =>
1530                   return;
1531
1532             end case;
1533          end loop;
1534       end Leading_Dollar;
1535
1536       -------------------
1537       -- Leading_Pound --
1538       -------------------
1539
1540       --  This one is complex!  A Leading_Pound can be fixed or floating,
1541       --  but in some cases the decision has to be deferred until we leave
1542       --  this procedure.  Also note that Leading_Pound can be called in
1543       --  either State.
1544
1545       --  It will set state to Okay only if a 9 or  (second) # is
1546       --  encountered.
1547
1548       --  One Last note:  In ambiguous cases, the currency is treated as
1549       --  floating unless there is only one '#'.
1550
1551       procedure Leading_Pound is
1552
1553          Inserts : Boolean := False;
1554          --  Set to True if a '_', '0', '/', 'B', or 'b' is encountered
1555
1556          Must_Float : Boolean := False;
1557          --  Set to true if a '#' occurs after an insert.
1558
1559       begin
1560          --  Treat as a floating currency. If it isn't, this will be
1561          --  overwritten later.
1562
1563          Pic.Floater := '#';
1564
1565          Pic.Start_Currency := Index;
1566          Pic.End_Currency := Index;
1567          Pic.Start_Float := Index;
1568          Pic.End_Float := Index;
1569
1570          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
1571          --  currency place.
1572
1573          Pic.Max_Currency_Digits := 1; --  we've seen one.
1574
1575          Skip; --  known '#'
1576
1577          loop
1578             if At_End then
1579                return;
1580             end if;
1581
1582             case Look is
1583
1584                when '_' | '0' | '/' =>
1585                   Pic.End_Float := Index;
1586                   Inserts := True;
1587                   Skip;
1588
1589                when 'B' | 'b'  =>
1590                   Pic.Picture.Expanded (Index) := 'b';
1591                   Pic.End_Float := Index;
1592                   Inserts := True;
1593                   Skip;
1594
1595                when 'Z' | 'z' =>
1596                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
1597
1598                   if Must_Float then
1599                      raise Picture_Error;
1600                   else
1601                      Pic.Max_Leading_Digits := 0;
1602
1603                      --  Will overwrite Floater and Start_Float
1604
1605                      Zero_Suppression;
1606                   end if;
1607
1608                when '*' =>
1609                   if Must_Float then
1610                      raise Picture_Error;
1611                   else
1612                      Pic.Max_Leading_Digits := 0;
1613
1614                      --  Will overwrite Floater and Start_Float
1615
1616                      Star_Suppression;
1617                   end if;
1618
1619                when '#' =>
1620                   if Inserts then
1621                      Must_Float := True;
1622                   end if;
1623
1624                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1625                   Pic.End_Float := Index;
1626                   Pic.End_Currency := Index;
1627                   Set_State (Okay);
1628                   Skip;
1629
1630                when '9' =>
1631                   if State /= Okay then
1632
1633                      --  A single '#' doesn't float.
1634
1635                      Pic.Floater := '!';
1636                      Pic.Start_Float := Invalid_Position;
1637                      Pic.End_Float := Invalid_Position;
1638                   end if;
1639
1640                   Number_Completion;
1641                   return;
1642
1643                when 'V' | 'v' | '.' =>
1644                   if State /= Okay then
1645                      Pic.Floater := '!';
1646                      Pic.Start_Float := Invalid_Position;
1647                      Pic.End_Float := Invalid_Position;
1648                   end if;
1649
1650                   --  Only one pound before the sign is okay,
1651                   --  but doesn't float.
1652
1653                   Pic.Radix_Position := Index;
1654                   Skip;
1655                   Number_Fraction_Or_Pound;
1656                   return;
1657
1658                when others =>
1659                   return;
1660             end case;
1661          end loop;
1662       end Leading_Pound;
1663
1664       ----------
1665       -- Look --
1666       ----------
1667
1668       function Look return Character is
1669       begin
1670          if At_End then
1671             raise Picture_Error;
1672          end if;
1673
1674          return Pic.Picture.Expanded (Index);
1675       end Look;
1676
1677       ------------
1678       -- Number --
1679       ------------
1680
1681       procedure Number is
1682       begin
1683          loop
1684
1685             case Look is
1686                when '_' | '0' | '/' =>
1687                   Skip;
1688
1689                when 'B' | 'b'  =>
1690                   Pic.Picture.Expanded (Index) := 'b';
1691                   Skip;
1692
1693                when '9' =>
1694                   Computed_BWZ := False;
1695                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1696                   Set_State (Okay);
1697                   Skip;
1698
1699                when '.' | 'V' | 'v' =>
1700                   Pic.Radix_Position := Index;
1701                   Skip;
1702                   Number_Fraction;
1703                   return;
1704
1705                when others =>
1706                   return;
1707
1708             end case;
1709
1710             if At_End then
1711                return;
1712             end if;
1713
1714             --  Will return in Okay state if a '9' was seen.
1715
1716          end loop;
1717       end Number;
1718
1719       -----------------------
1720       -- Number_Completion --
1721       -----------------------
1722
1723       procedure Number_Completion is
1724       begin
1725          while not At_End loop
1726             case Look is
1727
1728                when '_' | '0' | '/' =>
1729                   Skip;
1730
1731                when 'B' | 'b'  =>
1732                   Pic.Picture.Expanded (Index) := 'b';
1733                   Skip;
1734
1735                when '9' =>
1736                   Computed_BWZ := False;
1737                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
1738                   Set_State (Okay);
1739                   Skip;
1740
1741                when 'V' | 'v' | '.' =>
1742                   Pic.Radix_Position := Index;
1743                   Skip;
1744                   Number_Fraction;
1745                   return;
1746
1747                when others =>
1748                   return;
1749             end case;
1750          end loop;
1751       end Number_Completion;
1752
1753       ---------------------
1754       -- Number_Fraction --
1755       ---------------------
1756
1757       procedure Number_Fraction is
1758       begin
1759          --  Note that number fraction can be called in either State.
1760          --  It will set state to Valid only if a 9 is encountered.
1761
1762          loop
1763             if At_End then
1764                return;
1765             end if;
1766
1767             case Look is
1768                when '_' | '0' | '/' =>
1769                   Skip;
1770
1771                when 'B' | 'b'  =>
1772                   Pic.Picture.Expanded (Index) := 'b';
1773                   Skip;
1774
1775                when '9' =>
1776                   Computed_BWZ := False;
1777                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1778                   Set_State (Okay); Skip;
1779
1780                when others =>
1781                   return;
1782             end case;
1783          end loop;
1784       end Number_Fraction;
1785
1786       --------------------------------
1787       -- Number_Fraction_Or_Bracket --
1788       --------------------------------
1789
1790       procedure Number_Fraction_Or_Bracket is
1791       begin
1792          loop
1793             if At_End then
1794                return;
1795             end if;
1796
1797             case Look is
1798
1799                when '_' | '0' | '/' => Skip;
1800
1801                when 'B' | 'b'  =>
1802                   Pic.Picture.Expanded (Index) := 'b';
1803                   Skip;
1804
1805                when '<' =>
1806                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1807                   Pic.End_Float := Index;
1808                   Skip;
1809
1810                   loop
1811                      if At_End then
1812                         return;
1813                      end if;
1814
1815                      case Look is
1816                         when '_' | '0' | '/' =>
1817                            Skip;
1818
1819                         when 'B' | 'b'  =>
1820                            Pic.Picture.Expanded (Index) := 'b';
1821                            Skip;
1822
1823                         when '<' =>
1824                            Pic.Max_Trailing_Digits :=
1825                              Pic.Max_Trailing_Digits + 1;
1826                            Pic.End_Float := Index;
1827                            Skip;
1828
1829                         when others =>
1830                            return;
1831                      end case;
1832                   end loop;
1833
1834                when others =>
1835                   Number_Fraction;
1836                   return;
1837             end case;
1838          end loop;
1839       end Number_Fraction_Or_Bracket;
1840
1841       -------------------------------
1842       -- Number_Fraction_Or_Dollar --
1843       -------------------------------
1844
1845       procedure Number_Fraction_Or_Dollar is
1846       begin
1847          loop
1848             if At_End then
1849                return;
1850             end if;
1851
1852             case Look is
1853                when '_' | '0' | '/' =>
1854                   Skip;
1855
1856                when 'B' | 'b'  =>
1857                   Pic.Picture.Expanded (Index) := 'b';
1858                   Skip;
1859
1860                when '$' =>
1861                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1862                   Pic.End_Float := Index;
1863                   Skip;
1864
1865                   loop
1866                      if At_End then
1867                         return;
1868                      end if;
1869
1870                      case Look is
1871                         when '_' | '0' | '/' =>
1872                            Skip;
1873
1874                         when 'B' | 'b'  =>
1875                            Pic.Picture.Expanded (Index) := 'b';
1876                            Skip;
1877
1878                         when '$' =>
1879                            Pic.Max_Trailing_Digits :=
1880                              Pic.Max_Trailing_Digits + 1;
1881                            Pic.End_Float := Index;
1882                            Skip;
1883
1884                         when others =>
1885                            return;
1886                      end case;
1887                   end loop;
1888
1889                when others =>
1890                   Number_Fraction;
1891                   return;
1892             end case;
1893          end loop;
1894       end Number_Fraction_Or_Dollar;
1895
1896       ------------------------------
1897       -- Number_Fraction_Or_Pound --
1898       ------------------------------
1899
1900       procedure Number_Fraction_Or_Pound is
1901       begin
1902          loop
1903             if At_End then
1904                return;
1905             end if;
1906
1907             case Look is
1908
1909                when '_' | '0' | '/' =>
1910                   Skip;
1911
1912                when 'B' | 'b'  =>
1913                   Pic.Picture.Expanded (Index) := 'b';
1914                   Skip;
1915
1916                when '#' =>
1917                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1918                   Pic.End_Float := Index;
1919                   Skip;
1920
1921                   loop
1922                      if At_End then
1923                         return;
1924                      end if;
1925
1926                      case Look is
1927
1928                         when '_' | '0' | '/' =>
1929                            Skip;
1930
1931                         when 'B' | 'b'  =>
1932                            Pic.Picture.Expanded (Index) := 'b';
1933                            Skip;
1934
1935                         when '#' =>
1936                            Pic.Max_Trailing_Digits :=
1937                              Pic.Max_Trailing_Digits + 1;
1938                            Pic.End_Float := Index;
1939                            Skip;
1940
1941                         when others =>
1942                            return;
1943
1944                      end case;
1945                   end loop;
1946
1947                when others =>
1948                   Number_Fraction;
1949                   return;
1950
1951             end case;
1952          end loop;
1953       end Number_Fraction_Or_Pound;
1954
1955       ----------------------------------
1956       -- Number_Fraction_Or_Star_Fill --
1957       ----------------------------------
1958
1959       procedure Number_Fraction_Or_Star_Fill is
1960       begin
1961          loop
1962             if At_End then
1963                return;
1964             end if;
1965
1966             case Look is
1967
1968                when '_' | '0' | '/' =>
1969                   Skip;
1970
1971                when 'B' | 'b'  =>
1972                   Pic.Picture.Expanded (Index) := 'b';
1973                   Skip;
1974
1975                when '*' =>
1976                   Pic.Star_Fill := True;
1977                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
1978                   Pic.End_Float := Index;
1979                   Skip;
1980
1981                   loop
1982                      if At_End then
1983                         return;
1984                      end if;
1985
1986                      case Look is
1987
1988                         when '_' | '0' | '/' =>
1989                            Skip;
1990
1991                         when 'B' | 'b'  =>
1992                            Pic.Picture.Expanded (Index) := 'b';
1993                            Skip;
1994
1995                         when '*' =>
1996                            Pic.Star_Fill := True;
1997                            Pic.Max_Trailing_Digits :=
1998                              Pic.Max_Trailing_Digits + 1;
1999                            Pic.End_Float := Index;
2000                            Skip;
2001
2002                         when others =>
2003                            return;
2004                      end case;
2005                   end loop;
2006
2007                when others =>
2008                   Number_Fraction;
2009                   return;
2010
2011             end case;
2012          end loop;
2013       end Number_Fraction_Or_Star_Fill;
2014
2015       -------------------------------
2016       -- Number_Fraction_Or_Z_Fill --
2017       -------------------------------
2018
2019       procedure Number_Fraction_Or_Z_Fill is
2020       begin
2021          loop
2022             if At_End then
2023                return;
2024             end if;
2025
2026             case Look is
2027
2028                when '_' | '0' | '/' =>
2029                   Skip;
2030
2031                when 'B' | 'b'  =>
2032                   Pic.Picture.Expanded (Index) := 'b';
2033                   Skip;
2034
2035                when 'Z' | 'z' =>
2036                   Pic.Max_Trailing_Digits := Pic.Max_Trailing_Digits + 1;
2037                   Pic.End_Float := Index;
2038                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2039
2040                   Skip;
2041
2042                   loop
2043                      if At_End then
2044                         return;
2045                      end if;
2046
2047                      case Look is
2048
2049                         when '_' | '0' | '/' =>
2050                            Skip;
2051
2052                         when 'B' | 'b'  =>
2053                            Pic.Picture.Expanded (Index) := 'b';
2054                            Skip;
2055
2056                         when 'Z' | 'z' =>
2057                            Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2058
2059                            Pic.Max_Trailing_Digits :=
2060                              Pic.Max_Trailing_Digits + 1;
2061                            Pic.End_Float := Index;
2062                            Skip;
2063
2064                         when others =>
2065                            return;
2066                      end case;
2067                   end loop;
2068
2069                when others =>
2070                   Number_Fraction;
2071                   return;
2072             end case;
2073          end loop;
2074       end Number_Fraction_Or_Z_Fill;
2075
2076       -----------------------
2077       -- Optional_RHS_Sign --
2078       -----------------------
2079
2080       procedure Optional_RHS_Sign is
2081       begin
2082          if At_End then
2083             return;
2084          end if;
2085
2086          case Look is
2087
2088             when '+' | '-' =>
2089                Pic.Sign_Position := Index;
2090                Skip;
2091                return;
2092
2093             when 'C' | 'c' =>
2094                Pic.Sign_Position := Index;
2095                Pic.Picture.Expanded (Index) := 'C';
2096                Skip;
2097
2098                if Look = 'R' or Look = 'r' then
2099                   Pic.Second_Sign := Index;
2100                   Pic.Picture.Expanded (Index) := 'R';
2101                   Skip;
2102
2103                else
2104                   raise Picture_Error;
2105                end if;
2106
2107                return;
2108
2109             when 'D' | 'd' =>
2110                Pic.Sign_Position := Index;
2111                Pic.Picture.Expanded (Index) := 'D';
2112                Skip;
2113
2114                if Look = 'B' or Look = 'b' then
2115                   Pic.Second_Sign := Index;
2116                   Pic.Picture.Expanded (Index) := 'B';
2117                   Skip;
2118
2119                else
2120                   raise Picture_Error;
2121                end if;
2122
2123                return;
2124
2125             when '>' =>
2126                if Pic.Picture.Expanded (Pic.Sign_Position) = '<' then
2127                   Pic.Second_Sign := Index;
2128                   Skip;
2129
2130                else
2131                   raise Picture_Error;
2132                end if;
2133
2134             when others =>
2135                return;
2136
2137          end case;
2138       end Optional_RHS_Sign;
2139
2140       -------------
2141       -- Picture --
2142       -------------
2143
2144       --  Note that Picture can be called in either State.
2145
2146       --  It will set state to Valid only if a 9 is encountered or floating
2147       --  currency is called.
2148
2149       procedure Picture is
2150       begin
2151          loop
2152             if At_End then
2153                return;
2154             end if;
2155
2156             case Look is
2157
2158                when '_' | '0' | '/' =>
2159                   Skip;
2160
2161                when 'B' | 'b'  =>
2162                   Pic.Picture.Expanded (Index) := 'b';
2163                   Skip;
2164
2165                when '$' =>
2166                   Leading_Dollar;
2167                   return;
2168
2169                when '#' =>
2170                   Leading_Pound;
2171                   return;
2172
2173                when '9' =>
2174                   Computed_BWZ := False;
2175                   Set_State (Okay);
2176                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2177                   Skip;
2178
2179                when 'V' | 'v' | '.' =>
2180                   Pic.Radix_Position := Index;
2181                   Skip;
2182                   Number_Fraction;
2183                   Trailing_Currency;
2184                   return;
2185
2186                when others =>
2187                   return;
2188
2189             end case;
2190          end loop;
2191       end Picture;
2192
2193       ---------------------
2194       -- Picture_Bracket --
2195       ---------------------
2196
2197       procedure Picture_Bracket is
2198       begin
2199          Pic.Sign_Position := Index;
2200          Pic.Sign_Position := Index;
2201
2202          --  Treat as a floating sign, and unwind otherwise.
2203
2204          Pic.Floater := '<';
2205          Pic.Start_Float := Index;
2206          Pic.End_Float := Index;
2207
2208          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2209          --  sign place.
2210
2211          Skip; --  Known Bracket
2212
2213          loop
2214             case Look is
2215
2216                when '_' | '0' | '/' =>
2217                   Pic.End_Float := Index;
2218                   Skip;
2219
2220                when 'B' | 'b'  =>
2221                   Pic.End_Float := Index;
2222                   Pic.Picture.Expanded (Index) := 'b';
2223                   Skip;
2224
2225                when '<' =>
2226                   Set_State (Okay);  --  "<<>" is enough.
2227                   Floating_Bracket;
2228                   Trailing_Currency;
2229                   Trailing_Bracket;
2230                   return;
2231
2232                when '$' | '#' | '9' | '*' =>
2233                   if State /= Okay then
2234                      Pic.Floater := '!';
2235                      Pic.Start_Float := Invalid_Position;
2236                      Pic.End_Float := Invalid_Position;
2237                   end if;
2238
2239                   Picture;
2240                   Trailing_Bracket;
2241                   Set_State (Okay);
2242                   return;
2243
2244                when '.' | 'V' | 'v' =>
2245                   if State /= Okay then
2246                      Pic.Floater := '!';
2247                      Pic.Start_Float := Invalid_Position;
2248                      Pic.End_Float := Invalid_Position;
2249                   end if;
2250
2251                   --  Don't assume that state is okay, haven't seen a digit
2252
2253                   Picture;
2254                   Trailing_Bracket;
2255                   return;
2256
2257                when others =>
2258                   raise Picture_Error;
2259
2260             end case;
2261          end loop;
2262       end Picture_Bracket;
2263
2264       -------------------
2265       -- Picture_Minus --
2266       -------------------
2267
2268       procedure Picture_Minus is
2269       begin
2270          Pic.Sign_Position := Index;
2271
2272          --  Treat as a floating sign, and unwind otherwise.
2273
2274          Pic.Floater := '-';
2275          Pic.Start_Float := Index;
2276          Pic.End_Float := Index;
2277
2278          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2279          --  sign place.
2280
2281          Skip; --  Known Minus
2282
2283          loop
2284             case Look is
2285
2286                when '_' | '0' | '/' =>
2287                   Pic.End_Float := Index;
2288                   Skip;
2289
2290                when 'B' | 'b'  =>
2291                   Pic.End_Float := Index;
2292                   Pic.Picture.Expanded (Index) := 'b';
2293                   Skip;
2294
2295                when '-' =>
2296                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2297                   Pic.End_Float := Index;
2298                   Skip;
2299                   Set_State (Okay);  --  "-- " is enough.
2300                   Floating_Minus;
2301                   Trailing_Currency;
2302                   return;
2303
2304                when '$' | '#' | '9' | '*' =>
2305                   if State /= Okay then
2306                      Pic.Floater := '!';
2307                      Pic.Start_Float := Invalid_Position;
2308                      Pic.End_Float := Invalid_Position;
2309                   end if;
2310
2311                   Picture;
2312                   Set_State (Okay);
2313                   return;
2314
2315                when 'Z' | 'z' =>
2316
2317                   --  Can't have Z and a floating sign.
2318
2319                   if State = Okay then
2320                      Set_State (Reject);
2321                   end if;
2322
2323                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2324                   Zero_Suppression;
2325                   Trailing_Currency;
2326                   Optional_RHS_Sign;
2327                   return;
2328
2329                when '.' | 'V' | 'v' =>
2330                   if State /= Okay then
2331                      Pic.Floater := '!';
2332                      Pic.Start_Float := Invalid_Position;
2333                      Pic.End_Float := Invalid_Position;
2334                   end if;
2335
2336                   --  Don't assume that state is okay, haven't seen a digit.
2337
2338                   Picture;
2339                   return;
2340
2341                when others =>
2342                   return;
2343
2344             end case;
2345          end loop;
2346       end Picture_Minus;
2347
2348       ------------------
2349       -- Picture_Plus --
2350       ------------------
2351
2352       procedure Picture_Plus is
2353       begin
2354          Pic.Sign_Position := Index;
2355
2356          --  Treat as a floating sign, and unwind otherwise.
2357
2358          Pic.Floater := '+';
2359          Pic.Start_Float := Index;
2360          Pic.End_Float := Index;
2361
2362          --  Don't increment Pic.Max_Leading_Digits, we need one "real"
2363          --  sign place.
2364
2365          Skip; --  Known Plus
2366
2367          loop
2368             case Look is
2369
2370                when '_' | '0' | '/' =>
2371                   Pic.End_Float := Index;
2372                   Skip;
2373
2374                when 'B' | 'b'  =>
2375                   Pic.End_Float := Index;
2376                   Pic.Picture.Expanded (Index) := 'b';
2377                   Skip;
2378
2379                when '+' =>
2380                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2381                   Pic.End_Float := Index;
2382                   Skip;
2383                   Set_State (Okay);  --  "++" is enough.
2384                   Floating_Plus;
2385                   Trailing_Currency;
2386                   return;
2387
2388                when '$' | '#' | '9' | '*' =>
2389                   if State /= Okay then
2390                      Pic.Floater := '!';
2391                      Pic.Start_Float := Invalid_Position;
2392                      Pic.End_Float := Invalid_Position;
2393                   end if;
2394
2395                   Picture;
2396                   Set_State (Okay);
2397                   return;
2398
2399                when 'Z' | 'z' =>
2400                   if State = Okay then
2401                      Set_State (Reject);
2402                   end if;
2403
2404                   --  Can't have Z and a floating sign.
2405
2406                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2407
2408                   --  '+Z' is acceptable
2409
2410                   Set_State (Okay);
2411
2412                   Zero_Suppression;
2413                   Trailing_Currency;
2414                   Optional_RHS_Sign;
2415                   return;
2416
2417                when '.' | 'V' | 'v' =>
2418                   if State /= Okay then
2419                      Pic.Floater := '!';
2420                      Pic.Start_Float := Invalid_Position;
2421                      Pic.End_Float := Invalid_Position;
2422                   end if;
2423
2424                   --  Don't assume that state is okay, haven't seen a digit.
2425
2426                   Picture;
2427                   return;
2428
2429                when others =>
2430                   return;
2431
2432             end case;
2433          end loop;
2434       end Picture_Plus;
2435
2436       --------------------
2437       -- Picture_String --
2438       --------------------
2439
2440       procedure Picture_String is
2441       begin
2442          while Is_Insert loop
2443             Skip;
2444          end loop;
2445
2446          case Look is
2447
2448             when '$' | '#' =>
2449                Picture;
2450                Optional_RHS_Sign;
2451
2452             when '+' =>
2453                Picture_Plus;
2454
2455             when '-' =>
2456                Picture_Minus;
2457
2458             when '<' =>
2459                Picture_Bracket;
2460
2461             when 'Z' | 'z' =>
2462                Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2463                Zero_Suppression;
2464                Trailing_Currency;
2465                Optional_RHS_Sign;
2466
2467             when '*' =>
2468                Star_Suppression;
2469                Trailing_Currency;
2470                Optional_RHS_Sign;
2471
2472             when '9' | '.' | 'V' | 'v' =>
2473                Number;
2474                Trailing_Currency;
2475                Optional_RHS_Sign;
2476
2477             when others =>
2478                raise Picture_Error;
2479
2480          end case;
2481
2482          --  Blank when zero either if the PIC does not contain a '9' or if
2483          --  requested by the user and no '*'
2484
2485          Pic.Blank_When_Zero :=
2486            (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
2487
2488          --  Star fill if '*' and no '9'.
2489
2490          Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
2491
2492          if not At_End then
2493             Set_State (Reject);
2494          end if;
2495
2496       end Picture_String;
2497
2498       ---------------
2499       -- Set_State --
2500       ---------------
2501
2502       procedure Set_State (L : Legality) is
2503       begin
2504          State := L;
2505       end Set_State;
2506
2507       ----------
2508       -- Skip --
2509       ----------
2510
2511       procedure Skip is
2512       begin
2513          Index := Index + 1;
2514       end Skip;
2515
2516       ----------------------
2517       -- Star_Suppression --
2518       ----------------------
2519
2520       procedure Star_Suppression is
2521       begin
2522          Pic.Floater := '*';
2523          Pic.Start_Float := Index;
2524          Pic.End_Float := Index;
2525          Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2526          Set_State (Okay);
2527
2528          --  Even a single * is a valid picture
2529
2530          Pic.Star_Fill := True;
2531          Skip; --  Known *
2532
2533          loop
2534             if At_End then
2535                return;
2536             end if;
2537
2538             case Look is
2539
2540                when '_' | '0' | '/' =>
2541                   Pic.End_Float := Index;
2542                   Skip;
2543
2544                when 'B' | 'b'  =>
2545                   Pic.End_Float := Index;
2546                   Pic.Picture.Expanded (Index) := 'b';
2547                   Skip;
2548
2549                when '*' =>
2550                   Pic.End_Float := Index;
2551                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2552                   Set_State (Okay); Skip;
2553
2554                when '9' =>
2555                   Set_State (Okay);
2556                   Number_Completion;
2557                   return;
2558
2559                when '.' | 'V' | 'v' =>
2560                   Pic.Radix_Position := Index;
2561                   Skip;
2562                   Number_Fraction_Or_Star_Fill;
2563                   return;
2564
2565                when '#' | '$' =>
2566                   Trailing_Currency;
2567                   Set_State (Okay);
2568                   return;
2569
2570                when others => raise Picture_Error;
2571             end case;
2572          end loop;
2573       end Star_Suppression;
2574
2575       ----------------------
2576       -- Trailing_Bracket --
2577       ----------------------
2578
2579       procedure Trailing_Bracket is
2580       begin
2581          if Look = '>' then
2582             Pic.Second_Sign := Index;
2583             Skip;
2584          else
2585             raise Picture_Error;
2586          end if;
2587       end Trailing_Bracket;
2588
2589       -----------------------
2590       -- Trailing_Currency --
2591       -----------------------
2592
2593       procedure Trailing_Currency is
2594       begin
2595          if At_End then
2596             return;
2597          end if;
2598
2599          if Look = '$' then
2600             Pic.Start_Currency := Index;
2601             Pic.End_Currency := Index;
2602             Skip;
2603
2604          else
2605             while not At_End and then Look = '#' loop
2606                if Pic.Start_Currency = Invalid_Position then
2607                   Pic.Start_Currency := Index;
2608                end if;
2609
2610                Pic.End_Currency := Index;
2611                Skip;
2612             end loop;
2613          end if;
2614
2615          loop
2616             if At_End then
2617                return;
2618             end if;
2619
2620             case Look is
2621                when '_' | '0' | '/' => Skip;
2622
2623                when 'B' | 'b'  =>
2624                   Pic.Picture.Expanded (Index) := 'b';
2625                   Skip;
2626
2627                when others => return;
2628             end case;
2629          end loop;
2630       end Trailing_Currency;
2631
2632       ----------------------
2633       -- Zero_Suppression --
2634       ----------------------
2635
2636       procedure Zero_Suppression is
2637       begin
2638          Pic.Floater := 'Z';
2639          Pic.Start_Float := Index;
2640          Pic.End_Float := Index;
2641          Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2642          Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2643
2644          Skip; --  Known Z
2645
2646          loop
2647             --  Even a single Z is a valid picture
2648
2649             if At_End then
2650                Set_State (Okay);
2651                return;
2652             end if;
2653
2654             case Look is
2655                when '_' | '0' | '/' =>
2656                   Pic.End_Float := Index;
2657                   Skip;
2658
2659                when 'B' | 'b'  =>
2660                   Pic.End_Float := Index;
2661                   Pic.Picture.Expanded (Index) := 'b';
2662                   Skip;
2663
2664                when 'Z' | 'z' =>
2665                   Pic.Picture.Expanded (Index) := 'Z'; -- consistency
2666
2667                   Pic.Max_Leading_Digits := Pic.Max_Leading_Digits + 1;
2668                   Pic.End_Float := Index;
2669                   Set_State (Okay);
2670                   Skip;
2671
2672                when '9' =>
2673                   Set_State (Okay);
2674                   Number_Completion;
2675                   return;
2676
2677                when '.' | 'V' | 'v' =>
2678                   Pic.Radix_Position := Index;
2679                   Skip;
2680                   Number_Fraction_Or_Z_Fill;
2681                   return;
2682
2683                when '#' | '$' =>
2684                   Trailing_Currency;
2685                   Set_State (Okay);
2686                   return;
2687
2688                when others =>
2689                   return;
2690             end case;
2691          end loop;
2692       end Zero_Suppression;
2693
2694    --  Start of processing for Precalculate
2695
2696    begin
2697       Picture_String;
2698
2699       if State = Reject then
2700          raise Picture_Error;
2701       end if;
2702
2703    exception
2704
2705       when Constraint_Error =>
2706
2707          --  To deal with special cases like null strings.
2708
2709       raise Picture_Error;
2710
2711    end Precalculate;
2712
2713    ----------------
2714    -- To_Picture --
2715    ----------------
2716
2717    function To_Picture
2718      (Pic_String      : in String;
2719       Blank_When_Zero : in Boolean := False)
2720       return            Picture
2721    is
2722       Result : Picture;
2723
2724    begin
2725       declare
2726          Item : constant String := Expand (Pic_String);
2727
2728       begin
2729          Result.Contents.Picture         := (Item'Length, Item);
2730          Result.Contents.Original_BWZ := Blank_When_Zero;
2731          Result.Contents.Blank_When_Zero := Blank_When_Zero;
2732          Precalculate (Result.Contents);
2733          return Result;
2734       end;
2735
2736    exception
2737       when others =>
2738          raise Picture_Error;
2739
2740    end To_Picture;
2741
2742    -------------
2743    -- To_Wide --
2744    -------------
2745
2746    function To_Wide (C : Character) return Wide_Character is
2747    begin
2748       return Wide_Character'Val (Character'Pos (C));
2749    end To_Wide;
2750
2751    -----------
2752    -- Valid --
2753    -----------
2754
2755    function Valid
2756      (Pic_String      : in String;
2757       Blank_When_Zero : in Boolean := False)
2758       return            Boolean
2759    is
2760    begin
2761       declare
2762          Expanded_Pic : constant String := Expand (Pic_String);
2763          --  Raises Picture_Error if Item not well-formed
2764
2765          Format_Rec : Format_Record;
2766
2767       begin
2768          Format_Rec.Picture := (Expanded_Pic'Length, Expanded_Pic);
2769          Format_Rec.Blank_When_Zero := Blank_When_Zero;
2770          Format_Rec.Original_BWZ := Blank_When_Zero;
2771          Precalculate (Format_Rec);
2772
2773          --  False only if Blank_When_0 is True but the pic string
2774          --  has a '*'
2775
2776          return not Blank_When_Zero or
2777            Strings_Fixed.Index (Expanded_Pic, "*") = 0;
2778       end;
2779
2780    exception
2781       when others => return False;
2782
2783    end Valid;
2784
2785 end Ada.Wide_Text_IO.Editing;