home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / gnat-2.06-src.tgz / tar.out / fsf / gnat / ada / a-tiwtio.adb < prev    next >
Text File  |  1996-09-28  |  29KB  |  1,095 lines

  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --             A D A . T E X T _ I O . W I D E _ T E X T _ I O              --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.7 $                              --
  10. --                                                                          --
  11. --        Copyright (c) 1992,1993,1994,1995 NYU, All Rights Reserved        --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with Ada.Streams;          use Ada.Streams;
  27. with Interfaces.C_Streams; use Interfaces.C_Streams;
  28. with System;
  29. with System.File_IO;
  30. with System.WCh_Cnv;       use System.WCh_Cnv;
  31. with System.WCh_Con;       use System.WCh_Con;
  32. with Unchecked_Conversion;
  33. with Unchecked_Deallocation;
  34.  
  35. pragma Elaborate_All (System.File_IO);
  36. --  Needed because of calls to Chain_File in package body elaboration
  37.  
  38. package body Ada.Text_IO.Wide_Text_IO is
  39.  
  40.    package FIO renames System.File_IO;
  41.    package TIO renames Ada.Text_IO;
  42.  
  43.    subtype AP is FCB.AFCB_Ptr;
  44.  
  45.    function To_FCB is new Unchecked_Conversion (File_Mode, FCB.File_Mode);
  46.    function To_TIO is new Unchecked_Conversion (FCB.File_Mode, File_Mode);
  47.  
  48.    -----------------------
  49.    -- Local Subprograms --
  50.    -----------------------
  51.  
  52.    function Get_Wide_Char
  53.      (C    : Character;
  54.       File : File_Type)
  55.       return Wide_Character;
  56.    --  This function is shared by Get and Get_Immediate to extract a wide
  57.    --  character value from the given File. The first byte has already been
  58.    --  read and is passed in C. The wide character value is returned as the
  59.    --  result, and the file pointer is bumped past the character.
  60.  
  61.    -------------------
  62.    -- AFCB_Allocate --
  63.    -------------------
  64.  
  65.    function AFCB_Allocate
  66.      (Control_Block : Wide_Text_AFCB)
  67.       return          FCB.AFCB_Ptr
  68.    is
  69.    begin
  70.       return new Wide_Text_AFCB;
  71.    end AFCB_Allocate;
  72.  
  73.    ----------------
  74.    -- AFCB_Close --
  75.    ----------------
  76.  
  77.    procedure AFCB_Close (File : access Wide_Text_AFCB) is
  78.    begin
  79.       --  If the file being closed is one of the current files, then close
  80.       --  the corresponding current file. It is not clear that this action
  81.       --  is required (RM A.10.3(23)) but it seems reasonable, and besides
  82.       --  ACVC test CE3208A expects this behavior).
  83.  
  84.       if File = Current_In then
  85.          Current_In := null;
  86.       elsif File = Current_Out then
  87.          Current_Out := null;
  88.       elsif File = Current_Err then
  89.          Current_Err := null;
  90.       end if;
  91.  
  92.       --  Output line terminator if needed, but page terminator is implied
  93.  
  94.       if File.Mode /= FCB.In_File and then File.Col /= 1 then
  95.          New_Line (File);
  96.       end if;
  97.    end AFCB_Close;
  98.  
  99.    ---------------
  100.    -- AFCB_Free --
  101.    ---------------
  102.  
  103.    procedure AFCB_Free (File : access Wide_Text_AFCB) is
  104.       type FCB_Ptr is access all Wide_Text_AFCB;
  105.       FT : FCB_Ptr := File;
  106.  
  107.       procedure Free is new
  108.         Unchecked_Deallocation (Wide_Text_AFCB, FCB_Ptr);
  109.  
  110.    begin
  111.       Free (FT);
  112.    end AFCB_Free;
  113.  
  114.    -----------
  115.    -- Close --
  116.    -----------
  117.  
  118.    procedure Close (File : in out File_Type) is
  119.    begin
  120.       FIO.Close (AP (File));
  121.    end Close;
  122.  
  123.    ---------
  124.    -- Col --
  125.    ---------
  126.  
  127.    --  Note: we assume that it is impossible in practice for the column
  128.    --  to exceed the value of Count'Last, i.e. no check is required for
  129.    --  overflow raising layout error.
  130.  
  131.    function Col (File : in File_Type) return Positive_Count is
  132.    begin
  133.       return Positive_Count (TIO.Col (TIO.File_Type (File)));
  134.    end Col;
  135.  
  136.    function Col return Positive_Count is
  137.    begin
  138.       return Col (Current_Out);
  139.    end Col;
  140.  
  141.    ------------
  142.    -- Create --
  143.    ------------
  144.  
  145.    procedure Create
  146.      (File : in out File_Type;
  147.       Mode : in File_Mode := Out_File;
  148.       Name : in String := "";
  149.       Form : in String := "")
  150.    is
  151.       File_Control_Block : Wide_Text_AFCB;
  152.  
  153.    begin
  154.       FIO.Open (File_Ptr  => AP (File),
  155.                 Dummy_FCB => File_Control_Block,
  156.                 Mode      => To_FCB (Mode),
  157.                 Name      => Name,
  158.                 Form      => Form,
  159.                 Amethod   => 'W',
  160.                 Creat     => True,
  161.                 Text      => True);
  162.  
  163.       Setup (File);
  164.    end Create;
  165.  
  166.    -------------------
  167.    -- Current_Error --
  168.    -------------------
  169.  
  170.    function Current_Error return File_Type is
  171.    begin
  172.       return Current_Err;
  173.    end Current_Error;
  174.  
  175.    function Current_Error return File_Access is
  176.    begin
  177.       return Current_Err'Access;
  178.    end Current_Error;
  179.  
  180.    -------------------
  181.    -- Current_Input --
  182.    -------------------
  183.  
  184.    function Current_Input return File_Type is
  185.    begin
  186.       return Current_In;
  187.    end Current_Input;
  188.  
  189.    function Current_Input return File_Access is
  190.    begin
  191.       return Current_In'Access;
  192.    end Current_Input;
  193.  
  194.    --------------------
  195.    -- Current_Output --
  196.    --------------------
  197.  
  198.    function Current_Output return File_Type is
  199.    begin
  200.       return Current_Out;
  201.    end Current_Output;
  202.  
  203.    function Current_Output return File_Access is
  204.    begin
  205.       return Current_Out'Access;
  206.    end Current_Output;
  207.  
  208.    ------------
  209.    -- Delete --
  210.    ------------
  211.  
  212.    procedure Delete (File : in out File_Type) is
  213.    begin
  214.       FIO.Delete (AP (File));
  215.    end Delete;
  216.  
  217.    -----------------
  218.    -- End_Of_File --
  219.    -----------------
  220.  
  221.    function End_Of_File (File : in File_Type) return Boolean is
  222.    begin
  223.       return TIO.End_Of_File (TIO.File_Type (File));
  224.    end End_Of_File;
  225.  
  226.    function End_Of_File return Boolean is
  227.    begin
  228.       return TIO.End_Of_File (TIO.File_Type (Current_In));
  229.    end End_Of_File;
  230.  
  231.    -----------------
  232.    -- End_Of_Line --
  233.    -----------------
  234.  
  235.    function End_Of_Line (File : in File_Type) return Boolean is
  236.    begin
  237.       FIO.Check_Read_Status (AP (File));
  238.  
  239.       if File.Before_Wide_Character then
  240.          return False;
  241.       else
  242.          return TIO.End_Of_Line (TIO.File_Type (File));
  243.       end if;
  244.    end End_Of_Line;
  245.  
  246.    function End_Of_Line return Boolean is
  247.    begin
  248.       return End_Of_Line (Current_In);
  249.    end End_Of_Line;
  250.  
  251.    -----------------
  252.    -- End_Of_Page --
  253.    -----------------
  254.  
  255.    function End_Of_Page (File : in File_Type) return Boolean is
  256.    begin
  257.       FIO.Check_Read_Status (AP (File));
  258.  
  259.       if File.Before_Wide_Character then
  260.          return False;
  261.       else
  262.          return TIO.End_Of_Page (TIO.File_Type (File));
  263.       end if;
  264.    end End_Of_Page;
  265.  
  266.    function End_Of_Page return Boolean is
  267.    begin
  268.       return End_Of_Page (Current_In);
  269.    end End_Of_Page;
  270.  
  271.    -----------
  272.    -- Flush --
  273.    -----------
  274.  
  275.    procedure Flush (File : in out File_Type) is
  276.    begin
  277.       FIO.Flush (AP (File));
  278.    end Flush;
  279.  
  280.    procedure Flush is
  281.    begin
  282.       Flush (Current_Out);
  283.    end Flush;
  284.  
  285.    ----------
  286.    -- Form --
  287.    ----------
  288.  
  289.    function Form (File : in File_Type) return String is
  290.    begin
  291.       return FIO.Form (AP (File));
  292.    end Form;
  293.  
  294.    ---------
  295.    -- Get --
  296.    ---------
  297.  
  298.    procedure Get
  299.      (File : in File_Type;
  300.       Item : out Wide_Character)
  301.    is
  302.       C  : Character;
  303.  
  304.    begin
  305.       FIO.Check_Read_Status (AP (File));
  306.  
  307.       if File.Before_Wide_Character then
  308.          File.Before_Wide_Character := False;
  309.          Item := File.Saved_Wide_Character;
  310.  
  311.       else
  312.          TIO.Get (TIO.File_Type (File), C);
  313.          Item := Get_Wide_Char (C, File);
  314.       end if;
  315.    end Get;
  316.  
  317.    procedure Get (Item : out Wide_Character) is
  318.    begin
  319.       Get (Current_In, Item);
  320.    end Get;
  321.  
  322.    procedure Get
  323.      (File : in File_Type;
  324.       Item : out Wide_String)
  325.    is
  326.    begin
  327.       for J in Item'Range loop
  328.          Get (File, Item (J));
  329.       end loop;
  330.    end Get;
  331.  
  332.    procedure Get (Item : out Wide_String) is
  333.    begin
  334.       Get (Current_In, Item);
  335.    end Get;
  336.  
  337.    -------------------
  338.    -- Get_Immediate --
  339.    -------------------
  340.  
  341.    --  More work required here ???
  342.  
  343.    procedure Get_Immediate
  344.      (File : in File_Type;
  345.       Item : out Wide_Character)
  346.    is
  347.       ch : int;
  348.  
  349.    begin
  350.       FIO.Check_Read_Status (AP (File));
  351.  
  352.       if File.Before_Wide_Character then
  353.          File.Before_Wide_Character := False;
  354.          Item := File.Saved_Wide_Character;
  355.  
  356.       elsif File.Before_LM then
  357.          File.Before_LM := False;
  358.          File.Before_LM_PM := False;
  359.          Item := Wide_Character'Val (LM);
  360.  
  361.       else
  362.          ch := Getc (TIO.File_Type (File));
  363.  
  364.          if ch = EOF then
  365.             raise End_Error;
  366.          else
  367.             Item := Get_Wide_Char (Character'Val (ch), File);
  368.          end if;
  369.       end if;
  370.    end Get_Immediate;
  371.  
  372.    procedure Get_Immediate
  373.      (Item : out Wide_Character)
  374.    is
  375.    begin
  376.       Get_Immediate (Current_In, Item);
  377.    end Get_Immediate;
  378.  
  379.    procedure Get_Immediate
  380.      (File      : in File_Type;
  381.       Item      : out Wide_Character;
  382.       Available : out Boolean)
  383.    is
  384.       ch : int;
  385.  
  386.    begin
  387.       FIO.Check_Read_Status (AP (File));
  388.       Available := True;
  389.  
  390.       if File.Before_Wide_Character then
  391.          File.Before_Wide_Character := False;
  392.          Item := File.Saved_Wide_Character;
  393.  
  394.       elsif File.Before_LM then
  395.          File.Before_LM := False;
  396.          File.Before_LM_PM := False;
  397.          Item := Wide_Character'Val (LM);
  398.  
  399.       else
  400.          ch := Getc (TIO.File_Type (File));
  401.  
  402.          if ch = EOF then
  403.             raise End_Error;
  404.          else
  405.             Item := Get_Wide_Char (Character'Val (ch), File);
  406.          end if;
  407.       end if;
  408.    end Get_Immediate;
  409.  
  410.    procedure Get_Immediate
  411.      (Item      : out Wide_Character;
  412.       Available : out Boolean)
  413.    is
  414.    begin
  415.       Get_Immediate (Current_In, Item, Available);
  416.    end Get_Immediate;
  417.  
  418.    --------------
  419.    -- Get_Line --
  420.    --------------
  421.  
  422.    procedure Get_Line
  423.      (File : in File_Type;
  424.       Item : out Wide_String;
  425.       Last : out Natural)
  426.    is
  427.    begin
  428.       FIO.Check_Read_Status (AP (File));
  429.       Last := Item'First - 1;
  430.  
  431.       --  Immediate exit for null string, this is a case in which we do not
  432.       --  need to test for end of file and we do not skip a line mark under
  433.       --  any circumstances.
  434.  
  435.       if Last >= Item'Last then
  436.          return;
  437.       end if;
  438.  
  439.       --  Here we have at least one character, if we are immediately before
  440.       --  a line mark, then we will just skip past it storing no characters.
  441.  
  442.       if File.Before_LM then
  443.          File.Before_LM := False;
  444.          File.Before_LM_PM := False;
  445.  
  446.       --  Otherwise we need to read some characters
  447.  
  448.       else
  449.          --  If we are at the end of file now, it means we are trying to
  450.          --  skip a file terminator and we raise End_Error (RM A.10.7(20))
  451.  
  452.          if Nextc (TIO.File_Type (File)) = EOF then
  453.             raise End_Error;
  454.          end if;
  455.  
  456.          --  Loop through characters in string
  457.  
  458.          loop
  459.             --  Exit the loop if read is terminated by encountering line mark
  460.             --  Note that the use of Skip_Line here ensures we properly deal
  461.             --  with setting the page and line numbers.
  462.  
  463.             if End_Of_Line (File) then
  464.                Skip_Line (File);
  465.                return;
  466.             end if;
  467.  
  468.             --  Otherwise store the character, note that we know that ch is
  469.             --  something other than LM or EOF. It could possibly be a page
  470.             --  mark if there is a stray page mark in the middle of a line,
  471.             --  but this is not an official page mark in any case, since
  472.             --  official page marks can only follow a line mark. The whole
  473.             --  page business is pretty much nonsense anyway, so we do not
  474.             --  want to waste time trying to make sense out of non-standard
  475.             --  page marks in the file! This means that the behavior of
  476.             --  Get_Line is different from repeated Get of a character, but
  477.             --  that's too bad. We only promise that page numbers etc make
  478.             --  sense if the file is formatted in a standard manner.
  479.  
  480.             --  Note: we do not adjust the column number because it is quicker
  481.             --  to adjust it once at the end of the operation than incrementing
  482.             --  it each time around the loop.
  483.  
  484.             Last := Last + 1;
  485.             Get (File, Item (Last));
  486.  
  487.             --  All done if the string is full, this is the case in which
  488.             --  we do not skip the following line mark. We need to adjust
  489.             --  the column number in this case.
  490.  
  491.             if Last = Item'Last then
  492.                File.Col := File.Col + TIO.Count (Item'Length);
  493.                return;
  494.             end if;
  495.  
  496.             --  Exit from the loop if we are at the end of file. This happens
  497.             --  if we have a last line that is not terminated with a line mark.
  498.             --  In this case we consider that there is an implied line mark;
  499.             --  this is a non-standard file, but we will treat it nicely.
  500.  
  501.             exit when Nextc (TIO.File_Type (File)) = EOF;
  502.          end loop;
  503.       end if;
  504.    end Get_Line;
  505.  
  506.    procedure Get_Line
  507.      (Item : out Wide_String;
  508.       Last : out Natural)
  509.    is
  510.    begin
  511.       Get_Line (Current_In, Item, Last);
  512.    end Get_Line;
  513.  
  514.    -------------------
  515.    -- Get_Wide_Char --
  516.    -------------------
  517.  
  518.    function Get_Wide_Char
  519.      (C    : Character;
  520.       File : File_Type)
  521.       return Wide_Character
  522.    is
  523.       function In_Char return Character;
  524.       --  Function used to obtain additional characters it the wide character
  525.       --  sequence is more than one character long.
  526.  
  527.       function In_Char return Character is
  528.          ch : constant Integer := Getc (TIO.File_Type (File));
  529.  
  530.       begin
  531.          if ch = EOF then
  532.             raise End_Error;
  533.          else
  534.             return Character'Val (ch);
  535.          end if;
  536.       end In_Char;
  537.  
  538.       function WC_In is new Char_Sequence_To_Wide_Char (In_Char);
  539.  
  540.    begin
  541.       return WC_In (C, File.WC_Method);
  542.    end Get_Wide_Char;
  543.  
  544.    -------------
  545.    -- Is_Open --
  546.    -------------
  547.  
  548.    function Is_Open (File : in File_Type) return Boolean is
  549.    begin
  550.       return FIO.Is_Open (AP (File));
  551.    end Is_Open;
  552.  
  553.    ----------
  554.    -- Line --
  555.    ----------
  556.  
  557.    --  Note: we assume that it is impossible in practice for the line
  558.    --  to exceed the value of Count'Last, i.e. no check is required for
  559.    --  overflow raising layout error.
  560.  
  561.    function Line (File : in File_Type) return Positive_Count is
  562.    begin
  563.       return Positive_Count (TIO.Line (TIO.File_Type (File)));
  564.    end Line;
  565.  
  566.    function Line return Positive_Count is
  567.    begin
  568.       return Line (Current_Out);
  569.    end Line;
  570.  
  571.    -----------------
  572.    -- Line_Length --
  573.    -----------------
  574.  
  575.    function Line_Length (File : in File_Type) return Count is
  576.    begin
  577.       return Count (TIO.Line_Length (TIO.File_Type (File)));
  578.    end Line_Length;
  579.  
  580.    function Line_Length return Count is
  581.    begin
  582.       return Line_Length (Current_Out);
  583.    end Line_Length;
  584.  
  585.    ----------------
  586.    -- Look_Ahead --
  587.    ----------------
  588.  
  589.    procedure Look_Ahead
  590.      (File        : in File_Type;
  591.       Item        : out Wide_Character;
  592.       End_Of_Line : out Boolean)
  593.    is
  594.       ch : int;
  595.       WC : Wide_Character;
  596.  
  597.    --  Start of processing for Look_Ahead
  598.  
  599.    begin
  600.       FIO.Check_Read_Status (AP (File));
  601.  
  602.       --  If we are logically before a line mark, we can return immediately
  603.  
  604.       if File.Before_LM then
  605.          End_Of_Line := True;
  606.          Item := Wide_Character'Val (0);
  607.  
  608.       --  If we are before a wide character, just return it (this happens
  609.       --  if there are two calls to Look_Ahead in a row).
  610.  
  611.       elsif File.Before_Wide_Character then
  612.          End_Of_Line := False;
  613.          Item := File.Saved_Wide_Character;
  614.  
  615.       --  otherwise we must read a character from the input stream
  616.  
  617.       else
  618.          ch := Getc (TIO.File_Type (File));
  619.  
  620.          if ch = LM
  621.            or else ch = EOF
  622.            or else (ch = EOF and then File.Is_Regular_File)
  623.          then
  624.             End_Of_Line := True;
  625.             Ungetc (ch, TIO.File_Type (File));
  626.             Item := Wide_Character'Val (0);
  627.  
  628.          --  If the character is in the range 16#0000# to 16#007F# it stands
  629.          --  for itself and occupies a single byte, so we can unget it with
  630.          --  no difficulty.
  631.  
  632.          elsif ch <= 16#0080# then
  633.             End_Of_Line := False;
  634.             Ungetc (ch, TIO.File_Type (File));
  635.             Item := Wide_Character'Val (ch);
  636.  
  637.          --  For a character above this range, we read the character, using
  638.          --  the Get_Wide_Char routine. It may well occupy more than one byte
  639.          --  so we can't put it back with ungetc. Instead we save it in the
  640.          --  control block, setting a flag that everyone interested in reading
  641.          --  characters must test before reading the stream.
  642.  
  643.          else
  644.             Item := Get_Wide_Char (Character'Val (ch), File);
  645.             End_Of_Line := False;
  646.             File.Saved_Wide_Character := Item;
  647.             File.Before_Wide_Character := True;
  648.          end if;
  649.       end if;
  650.    end Look_Ahead;
  651.  
  652.    procedure Look_Ahead
  653.      (Item        : out Wide_Character;
  654.       End_Of_Line : out Boolean)
  655.    is
  656.    begin
  657.       Look_Ahead (Standard_In, Item, End_Of_Line);
  658.    end Look_Ahead;
  659.  
  660.    ----------
  661.    -- Mode --
  662.    ----------
  663.  
  664.    function Mode (File : in File_Type) return File_Mode is
  665.    begin
  666.       return To_TIO (FIO.Mode (AP (File)));
  667.    end Mode;
  668.  
  669.    ----------
  670.    -- Name --
  671.    ----------
  672.  
  673.    function Name (File : in File_Type) return String is
  674.    begin
  675.       return FIO.Name (AP (File));
  676.    end Name;
  677.  
  678.    --------------
  679.    -- New_Line --
  680.    --------------
  681.  
  682.    procedure New_Line
  683.      (File    : in File_Type;
  684.       Spacing : in Positive_Count := 1)
  685.    is
  686.    begin
  687.       TIO.New_Line (TIO.File_Type (File), TIO.Positive_Count (Spacing));
  688.    end New_Line;
  689.  
  690.    procedure New_Line (Spacing : in Positive_Count := 1) is
  691.    begin
  692.       New_Line (Current_Out, Spacing);
  693.    end New_Line;
  694.  
  695.    --------------
  696.    -- New_Page --
  697.    --------------
  698.  
  699.    procedure New_Page (File : in File_Type) is
  700.    begin
  701.       TIO.New_Page (TIO.File_Type (File));
  702.    end New_Page;
  703.  
  704.    procedure New_Page is
  705.    begin
  706.       New_Page (Current_Out);
  707.    end New_Page;
  708.  
  709.    ----------
  710.    -- Open --
  711.    ----------
  712.  
  713.    procedure Open
  714.      (File : in out File_Type;
  715.       Mode : in File_Mode;
  716.       Name : in String;
  717.       Form : in String := "")
  718.    is
  719.       File_Control_Block : Wide_Text_AFCB;
  720.  
  721.    begin
  722.       FIO.Open (File_Ptr  => AP (File),
  723.                 Dummy_FCB => File_Control_Block,
  724.                 Mode      => To_FCB (Mode),
  725.                 Name      => Name,
  726.                 Form      => Form,
  727.                 Amethod   => 'T',
  728.                 Creat     => False,
  729.                 Text      => True);
  730.  
  731.       Setup (File);
  732.    end Open;
  733.  
  734.    ----------
  735.    -- Page --
  736.    ----------
  737.  
  738.    --  Note: we assume that it is impossible in practice for the page
  739.    --  to exceed the value of Count'Last, i.e. no check is required for
  740.    --  overflow raising layout error.
  741.  
  742.    function Page (File : in File_Type) return Positive_Count is
  743.    begin
  744.       return Positive_Count (TIO.Page (TIO.File_Type (File)));
  745.    end Page;
  746.  
  747.    function Page return Positive_Count is
  748.    begin
  749.       return Page (Current_Out);
  750.    end Page;
  751.  
  752.    -----------------
  753.    -- Page_Length --
  754.    -----------------
  755.  
  756.    function Page_Length (File : in File_Type) return Count is
  757.    begin
  758.       return Count (TIO.Page_Length (TIO.File_Type (File)));
  759.    end Page_Length;
  760.  
  761.    function Page_Length return Count is
  762.    begin
  763.       return Page_Length (Current_Out);
  764.    end Page_Length;
  765.  
  766.    ---------
  767.    -- Put --
  768.    ---------
  769.  
  770.    procedure Put
  771.      (File : in File_Type;
  772.       Item : in Wide_Character)
  773.    is
  774.       procedure Out_Char (C : Character);
  775.       --  Procedure to output one character of a wide character sequence
  776.  
  777.       procedure Out_Char (C : Character) is
  778.       begin
  779.          Putc (Character'Pos (C), TIO.File_Type (File));
  780.       end Out_Char;
  781.  
  782.       procedure WC_Out is new Wide_Char_To_Char_Sequence (Out_Char);
  783.  
  784.    begin
  785.       WC_Out (Item, File.WC_Method);
  786.       File.Col := File.Col + 1;
  787.    end Put;
  788.  
  789.    procedure Put (Item : in Wide_Character) is
  790.    begin
  791.       Put (Current_Out, Item);
  792.    end Put;
  793.  
  794.    ---------
  795.    -- Put --
  796.    ---------
  797.  
  798.    procedure Put
  799.      (File : in File_Type;
  800.       Item : in Wide_String)
  801.    is
  802.    begin
  803.       for J in Item'Range loop
  804.          Put (File, Item (J));
  805.       end loop;
  806.    end Put;
  807.  
  808.    procedure Put (Item : in Wide_String) is
  809.    begin
  810.       Put (Current_Out, Item);
  811.    end Put;
  812.  
  813.    --------------
  814.    -- Put_Line --
  815.    --------------
  816.  
  817.    procedure Put_Line
  818.      (File : in File_Type;
  819.       Item : in Wide_String)
  820.    is
  821.    begin
  822.       Put (File, Item);
  823.       New_Line (File);
  824.    end Put_Line;
  825.  
  826.    procedure Put_Line (Item : in Wide_String) is
  827.    begin
  828.       Put (Current_Out, Item);
  829.       New_Line (Current_Out);
  830.    end Put_Line;
  831.  
  832.    -----------
  833.    -- Reset --
  834.    -----------
  835.  
  836.    procedure Reset
  837.      (File : in out File_Type;
  838.       Mode : in File_Mode)
  839.    is
  840.       function To_TIO_Mode is
  841.         new Unchecked_Conversion (File_Mode, TIO.File_Mode);
  842.  
  843.    begin
  844.       TIO.Reset (TIO.File_Type (File), To_TIO_Mode (Mode));
  845.       File.Before_Wide_Character := False;
  846.    end Reset;
  847.  
  848.    procedure Reset (File : in out File_Type) is
  849.    begin
  850.       TIO.Reset (TIO.File_Type (File));
  851.       File.Before_Wide_Character := False;
  852.    end Reset;
  853.  
  854.    -------------
  855.    -- Set_Col --
  856.    -------------
  857.  
  858.    procedure Set_Col
  859.      (File : in File_Type;
  860.       To   : in Positive_Count)
  861.    is
  862.    begin
  863.       TIO.Set_Col (TIO.File_Type (File), TIO.Positive_Count (To));
  864.    end Set_Col;
  865.  
  866.    procedure Set_Col (To : in Positive_Count) is
  867.    begin
  868.       Set_Col (Current_Out, To);
  869.    end Set_Col;
  870.  
  871.    ---------------
  872.    -- Set_Error --
  873.    ---------------
  874.  
  875.    procedure Set_Error (File : in File_Type) is
  876.    begin
  877.       FIO.Check_Write_Status (AP (File));
  878.       Current_Err := File;
  879.    end Set_Error;
  880.  
  881.    ---------------
  882.    -- Set_Input --
  883.    ---------------
  884.  
  885.    procedure Set_Input (File : in File_Type) is
  886.    begin
  887.       FIO.Check_Read_Status (AP (File));
  888.       Current_In := File;
  889.    end Set_Input;
  890.  
  891.    --------------
  892.    -- Set_Line --
  893.    --------------
  894.  
  895.    procedure Set_Line
  896.      (File : in File_Type;
  897.       To   : in Positive_Count)
  898.    is
  899.    begin
  900.       TIO.Set_Line (TIO.File_Type (File), TIO.Positive_Count (To));
  901.       File.Before_Wide_Character := False;
  902.    end Set_Line;
  903.  
  904.    procedure Set_Line (To : in Positive_Count) is
  905.    begin
  906.       Set_Line (Current_Out, To);
  907.    end Set_Line;
  908.  
  909.    ---------------------
  910.    -- Set_Line_Length --
  911.    ---------------------
  912.  
  913.    procedure Set_Line_Length (File : in File_Type; To : in Count) is
  914.    begin
  915.       TIO.Set_Line_Length (TIO.File_Type (File), TIO.Count (To));
  916.    end Set_Line_Length;
  917.  
  918.    procedure Set_Line_Length (To : in Count) is
  919.    begin
  920.       Set_Line_Length (Current_Out, To);
  921.    end Set_Line_Length;
  922.  
  923.    ----------------
  924.    -- Set_Output --
  925.    ----------------
  926.  
  927.    procedure Set_Output (File : in File_Type) is
  928.    begin
  929.       FIO.Check_Write_Status (AP (File));
  930.       Current_Out := File;
  931.    end Set_Output;
  932.  
  933.    ---------------------
  934.    -- Set_Page_Length --
  935.    ---------------------
  936.  
  937.    procedure Set_Page_Length (File : in File_Type; To : in Count) is
  938.    begin
  939.       TIO.Set_Page_Length (TIO.File_Type (File), TIO.Count (To));
  940.    end Set_Page_Length;
  941.  
  942.    procedure Set_Page_Length (To : in Count) is
  943.    begin
  944.       Set_Page_Length (Current_Out, To);
  945.    end Set_Page_Length;
  946.  
  947.    -----------
  948.    -- Setup --
  949.    -----------
  950.  
  951.    procedure Setup (File : File_Type) is
  952.       Start, Stop : Natural;
  953.  
  954.    begin
  955.       FIO.Form_Parameter (File.Form.all, "wcem", Start, Stop);
  956.  
  957.       if Start = 0 then
  958.          null;
  959.  
  960.       elsif Start /= Stop then
  961.          raise Use_Error;
  962.  
  963.       else
  964.          for J in WC_Encoding_Method loop
  965.             if File.Form (Start) = WC_Encoding_Letters (J) then
  966.                File.WC_Method := J;
  967.                return;
  968.             end if;
  969.          end loop;
  970.  
  971.          raise Use_Error;
  972.       end if;
  973.  
  974.    end Setup;
  975.  
  976.    ---------------
  977.    -- Skip_Line --
  978.    ---------------
  979.  
  980.    procedure Skip_Line
  981.      (File    : in File_Type;
  982.       Spacing : in Positive_Count := 1)
  983.    is
  984.    begin
  985.       TIO.Skip_Line (TIO.File_Type (File), TIO.Positive_Count (Spacing));
  986.       File.Before_Wide_Character := False;
  987.    end Skip_Line;
  988.  
  989.    procedure Skip_Line (Spacing : in Positive_Count := 1) is
  990.    begin
  991.       Skip_Line (Current_In, Spacing);
  992.    end Skip_Line;
  993.  
  994.    ---------------
  995.    -- Skip_Page --
  996.    ---------------
  997.  
  998.    procedure Skip_Page (File : in File_Type) is
  999.    begin
  1000.       TIO.Skip_Page (TIO.File_Type (File));
  1001.       File.Before_Wide_Character := False;
  1002.    end Skip_Page;
  1003.  
  1004.    procedure Skip_Page is
  1005.    begin
  1006.       Skip_Page (Current_In);
  1007.    end Skip_Page;
  1008.  
  1009.    --------------------
  1010.    -- Standard_Error --
  1011.    --------------------
  1012.  
  1013.    function Standard_Error return File_Type is
  1014.    begin
  1015.       return Standard_Err;
  1016.    end Standard_Error;
  1017.  
  1018.    function Standard_Error return File_Access is
  1019.    begin
  1020.       return Standard_Err'Access;
  1021.    end Standard_Error;
  1022.  
  1023.    --------------------
  1024.    -- Standard_Input --
  1025.    --------------------
  1026.  
  1027.    function Standard_Input return File_Type is
  1028.    begin
  1029.       return Standard_In;
  1030.    end Standard_Input;
  1031.  
  1032.    function Standard_Input return File_Access is
  1033.    begin
  1034.       return Standard_In'Access;
  1035.    end Standard_Input;
  1036.  
  1037.    ---------------------
  1038.    -- Standard_Output --
  1039.    ---------------------
  1040.  
  1041.    function Standard_Output return File_Type is
  1042.    begin
  1043.       return Standard_Out;
  1044.    end Standard_Output;
  1045.  
  1046.    function Standard_Output return File_Access is
  1047.    begin
  1048.       return Standard_Out'Access;
  1049.    end Standard_Output;
  1050.  
  1051. begin
  1052.    -------------------------------
  1053.    -- Initialize Standard Files --
  1054.    -------------------------------
  1055.  
  1056.    --  Note: the names in these files are bogus, and probably it would be
  1057.    --  better for these files to have no names, but the ACVC test insist!
  1058.    --  We use names that are bound to fail in open etc.
  1059.  
  1060.    Standard_In.Stream             := stdin;
  1061.    Standard_In.Name               := new String'("*stdin");
  1062.    Standard_In.Form               := Null_Str'Access;
  1063.    Standard_In.Mode               := FCB.In_File;
  1064.    Standard_In.Is_Regular_File    := is_regular_file (fileno (stdin)) /= 0;
  1065.    Standard_In.Is_Temporary_File  := False;
  1066.    Standard_In.Is_System_File     := True;
  1067.    Standard_In.Is_Text_File       := True;
  1068.    Standard_In.Access_Method      := 'W';
  1069.  
  1070.    Standard_Out.Stream            := stdout;
  1071.    Standard_Out.Name              := new String'("*stdout");
  1072.    Standard_Out.Form              := Null_Str'Access;
  1073.    Standard_Out.Mode              := FCB.Out_File;
  1074.    Standard_Out.Is_Regular_File   := is_regular_file (fileno (stdout)) /= 0;
  1075.    Standard_Out.Is_Temporary_File := False;
  1076.    Standard_Out.Is_System_File    := True;
  1077.    Standard_Out.Is_Text_File      := True;
  1078.    Standard_Out.Access_Method     := 'W';
  1079.  
  1080.    Standard_Err.Stream            := stderr;
  1081.    Standard_Err.Name              := new String'("*stderr");
  1082.    Standard_Err.Form              := Null_Str'Access;
  1083.    Standard_Err.Mode              := FCB.Out_File;
  1084.    Standard_Err.Is_Regular_File   := is_regular_file (fileno (stderr)) /= 0;
  1085.    Standard_Err.Is_Temporary_File := False;
  1086.    Standard_Err.Is_System_File    := True;
  1087.    Standard_Err.Is_Text_File      := True;
  1088.    Standard_Err.Access_Method     := 'W';
  1089.  
  1090.    FIO.Chain_File (AP (Standard_In));
  1091.    FIO.Chain_File (AP (Standard_Out));
  1092.    FIO.Chain_File (AP (Standard_Err));
  1093.  
  1094. end Ada.Text_IO.Wide_Text_IO;
  1095.