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