----------------------------------------------------------------------------- -- -- Copyright 2004 Björn Persson. -- -- This library is free software; you can redistribute it and/or modify it -- under the terms of the GNU General Public License, version 2, as published -- by the Free Software Foundation. -- -- As a special exception, if other files instantiate generics from this -- unit, or you link this unit with other files to produce an executable, -- this unit does not by itself cause the resulting executable to be covered -- by the General Public License. This exception does not however invalidate -- any other reasons why the executable file might be covered by the General -- Public License. -- ---------------------------------------------------------------------------- pragma License (Modified_Gpl); pragma Ada_2022; with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with Ada.Text_IO.Text_Streams; package body AdaCL.EAstrings.IO is use OS; use type Stream_IO.Stream_Access; use type File_Mode; -- Current_Input : constant EAstream_Pointer := Standard_Input; -- Current_Output : constant EAstream_Pointer := Standard_Output; type Read_Buffer_Pointer is access Stream_Element_Array; procedure Free is new Ada.Unchecked_Deallocation ( Stream_Element_Array, Read_Buffer_Pointer); procedure Double (Pointer : in out Read_Buffer_Pointer); function Encoding_Reading (File : EAstream'Class) return Character_Encoding; -- Returns the encoding that data from this file will have when it is -- read. This is the file's encoding if it is known to have a fixed -- character width. Otherwise it's UCS-4. function Is_Line_Break (Item : EAstring; File : EAstream) return Boolean; -- True if Item is equal to one of the recognized line breaks for File. function Is_Line_Break_Head (Item : EAstring; File : EAstream) return Boolean; -- True if Item is the first character of a recognized two-character line -- break for File. procedure Transcode (Item : in out Line_Break_Array; New_Encoding : in Character_Encoding); -- Tries to convert all the line break strings in Item to New_Encoding, -- and marks them as impossible for the encoding if they can't be -- converted. function "+" (Item : Byte_Sequence) return Stream_Element_Array; function "+" (Item : Stream_Element_Array) return Byte_Sequence; --------- -- "+" -- --------- function "+" (Item : Byte_Sequence) return Stream_Element_Array is subtype In_Type is Byte_Sequence (Item'First .. Item'Last); subtype Out_Type is Stream_Element_Array ( Stream_Element_Offset (Item'First) .. Stream_Element_Offset (Item'Last)); function Convert is new Ada.Unchecked_Conversion (In_Type, Out_Type); begin return Convert (Item); end "+"; function "+" (Item : Stream_Element_Array) return Byte_Sequence is subtype In_Type is Stream_Element_Array (Item'First .. Item'Last); subtype Out_Type is Byte_Sequence ( Natural (Item'First) .. Natural (Item'Last)); function Convert is new Ada.Unchecked_Conversion (In_Type, Out_Type); begin return Convert (Item); end "+"; ----------- -- Close -- ----------- procedure Close (File : in out EAfile) is begin Stream_IO.Close (File.Base_File); Close_Converter (File.Converter); end Close; ------------- -- Connect -- ------------- procedure Connect (File : in out Stream_EAstream; Stream : in Stream_IO.Stream_Access; Encoding : in Character_Encoding := OS.OS_Encoding) is begin if File.Converter /= Null_Converter then Close_Converter (File.Converter); end if; if not Fixed_Width (Encoding) then File.Converter := Open_Converter (From => Encoding, To => UCS_4); end if; File.Encoding := Encoding; Transcode (File.Line_Break, Encoding); Transcode (File.Line_Breaks.all, Encoding_Reading (File)); File.Stream := Stream; Tail (File.Line_Break_Buffer, 0); File.Ended := False; end Connect; ------------ -- Create -- ------------ procedure Create (File : in out EAfile; Name : in EAstring := Null_EAstring; Encoding : in Character_Encoding := OS_Encoding; Form : in String := "") is begin Stream_IO.Create (File.Base_File, Out_File, Byte_Sequence_To_Fake_String (Bytes (Transcode (Name, OS_Encoding))), Form); File.Encoding := Encoding; Transcode (File.Line_Break, Encoding); Tail (File.Line_Break_Buffer, 0); File.Ended := False; end Create; -- ------------------- -- -- Current_Error -- -- ------------------- -- -- function Current_Error return EAstream renames Standard_Error; ------------------- -- Current_Input -- ------------------- function Current_Input return EAstream_Pointer renames Standard_Input; -------------------- -- Current_Output -- -------------------- function Current_Output return EAstream_Pointer renames Standard_Output; ------------ -- Delete -- ------------ procedure Delete (File : in out EAfile) is begin Stream_IO.Delete (File.Base_File); Close_Converter (File.Converter); end Delete; ------------ -- Double -- ------------ procedure Double (Pointer : in out Read_Buffer_Pointer) is Temp : constant Read_Buffer_Pointer := new Stream_Element_Array ( Pointer'First .. Pointer'First + 2 * Pointer'Length); begin Temp.all (Pointer'Range) := Pointer.all; Free (Pointer); Pointer := Temp; end Double; -------------- -- Encoding -- -------------- function Encoding (File : in EAstream) return Character_Encoding is begin return File.Encoding; end Encoding; ---------------------- -- Encoding_Reading -- ---------------------- function Encoding_Reading (File : EAstream'Class) return Character_Encoding is begin if File.Converter = Null_Converter then return File.Encoding; else return UCS_4; end if; end Encoding_Reading; ----------------- -- End_Of_File -- ----------------- function End_Of_File (File : in EAstream) return Boolean is begin return File.Ended; end End_Of_File; -------------- -- Finalize -- -------------- overriding procedure Finalize (Object : in out EAstream) is procedure Deallocate is new Ada.Unchecked_Deallocation ( Line_Break_Array, Line_Break_Pointer); begin Deallocate (Object.Line_Breaks); Close_Converter (Object.Converter); end Finalize; ----------- -- Flush -- ----------- procedure Flush (File : in EAfile) is begin Stream_IO.Flush (File.Base_File); end Flush; ---------- -- Form -- ---------- function Form (File : in EAfile) return String is begin return Stream_IO.Form (File.Base_File); end Form; --------- -- Get -- --------- procedure Get (File : in out EAstream; Item : out EAstring; Length : in Natural; Exit_Cause : out Read_Stop_Cause) is type P is access constant EAstream'Class; F : constant P := File'Access; -- The reason for P and F is that Gnat says the call "Stream(File)" is not -- dispatching. begin Item := Null_EAstring; if Length = 0 then Exit_Cause := All_Done; return; end if; if File.Ended then Exit_Cause := End_Of_File; return; end if; if File.Converter = Null_Converter then -- The file has a fixed-width encoding. We can fill the string with -- one read, but we may have to finish a line break first. declare Char_Width : constant Stream_Element_Offset := Stream_Element_Offset (Width (File.Encoding)); Buffer : Stream_Element_Array ( 1 .. Char_Width * Stream_Element_Offset (Length)); Buffer_Last : Stream_Element_Offset; Continue_Pos : Stream_Element_Offset := 1; begin if EAstrings.Length (File.Line_Break_Buffer) /= 0 then -- Read one character and see if it is a continuation of the -- line break. Read (Stream (F.all).all, Buffer (1 .. Char_Width), Buffer_Last); if Buffer_Last < Char_Width then -- End of file. if Buffer_Last = 0 then -- There was nothing left to -- read. Exit_Cause := End_Of_File; else -- The file ended with an unfinished character. Exit_Cause := Incomplete; end if; File.Ended := True; return; end if; if not Is_Line_Break (File.Line_Break_Buffer & To_EAstring (+Buffer (1 .. Char_Width), File.Encoding), File) then -- The character does not belong to the line break. Keep it -- in the buffer as the first character of the string. Continue_Pos := Char_Width + 1; end if; end if; -- Read (the rest of) the string. if Continue_Pos <= Buffer'Last then Read (Stream (F.all).all, Buffer (Continue_Pos .. Buffer'Last), Buffer_Last); end if; if Buffer_Last = Buffer'Last then -- All is well. Exit_Cause := All_Done; else -- End of file. File.Ended := True; if Buffer_Last mod Char_Width = 0 then -- Too little data. Exit_Cause := End_Of_File; else -- The file ended with an unfinished character. Exit_Cause := Incomplete; Buffer_Last := Buffer_Last - Buffer_Last mod Char_Width; end if; end if; Item := To_EAstring (+Buffer (1 .. Buffer_Last), File.Encoding); end; else -- The file has a variable-width or unknown encoding. We must read -- one byte at a time and transcode to know when to stop. declare -- Guess at how long the buffer needs to be and grow it later if -- necessary. Buffer : Read_Buffer_Pointer := new Stream_Element_Array (1 .. 4); Pos : Stream_Element_Offset := 1; Buffer_Last : Stream_Element_Offset; Target : Byte_Sequence (1 .. 4 * Length); Source_Last : Positive; Target_Last : Natural := 0; Converter_Status : Conversion_Stop_Cause; Finishing_Line_Break : Boolean := EAstrings.Length (File.Line_Break_Buffer) /= 0; begin loop Read (Stream (F.all).all, Buffer.all (Pos .. Pos), Buffer_Last); if Buffer_Last < Pos then -- End of file. if Pos = 1 then -- There was too little data left to -- read. Exit_Cause := End_Of_File; else -- The file ended with an unfinished character. Exit_Cause := Incomplete; end if; File.Ended := True; exit; end if; Convert (File.Converter, +Buffer.all (1 .. Pos), Target (Target_Last + 1 .. Target'Last), Source_Last, Target_Last, Converter_Status); case Converter_Status is when All_Done => if Finishing_Line_Break then if Is_Line_Break (File.Line_Break_Buffer & To_EAstring (Target (1 .. 4), UCS_4), File) then -- The character we just read completes the line -- break and must not be included in the string -- we're supposed to read. Target_Last := 0; end if; Tail (File.Line_Break_Buffer, 0); Finishing_Line_Break := False; end if; if Target_Last = Target'Last then -- The requested number of characters have been read. Exit_Cause := All_Done; exit; else -- Continue with the next character. Pos := 1; end if; when Incomplete => -- Read another byte and try again. Pos := Pos + 1; if Pos > Buffer'Last then Double (Buffer); end if; when Inconvertible => -- Stop with error state. Exit_Cause := Invalid; exit; when Target_Full => -- Won't happen. null; end case; end loop; Item := To_EAstring (Target (1 .. Target_Last), UCS_4); Free (Buffer); exception when others => Free (Buffer); raise; end; end if; end Get; procedure Get (File : in out EAstream; Item : out EAstring; Length : in Natural) is Exit_Cause : Read_Stop_Cause; begin Get (File, Item, Length, Exit_Cause); case Exit_Cause is when Incomplete => raise Incomplete_Byte_Sequence; when Invalid => raise Invalid_Byte_Sequence; when End_Of_File => raise End_Error; when All_Done => null; end case; end Get; procedure Get (Item : out EAstring; Length : in Natural) is begin Get (Current_Input.all, Item, Length); end Get; -------------- -- Get_Line -- -------------- procedure Get_Line (File : in out EAstream; Item : out EAstring; Exit_Cause : out Read_Stop_Cause) is type P is access constant EAstream'Class; F : constant P := File'Access; -- The reason for P and F is that Gnat says the call "Stream(File)" is -- not dispatching. Buffer : Read_Buffer_Pointer; Finishing_Line_Break : Boolean := Length (File.Line_Break_Buffer) /= 0; begin -- Empty the string but keep the allocated space. (EAstring is a -- by-reference type.) Tail (Item, 0); if File.Ended then Exit_Cause := End_Of_File; return; end if; if File.Converter /= Null_Converter then -- The buffer is allocated outside the loop to avoid allocating and -- deallocating it for every character. Guess at how long the buffer -- needs to be and grow it later if necessary. Buffer := new Stream_Element_Array (1 .. 4); end if; Read_Line : loop if File.Converter = Null_Converter then -- The file has a fixed-width encoding. declare Buffer : Stream_Element_Array ( 1 .. Stream_Element_Offset (Width (File.Encoding))); Buffer_Last : Stream_Element_Offset; begin Read (Stream (F.all).all, Buffer, Buffer_Last); if Buffer_Last < Buffer'Last then -- End of file. if Buffer_Last = 0 then -- Clean end. Exit_Cause := End_Of_File; else -- The file ended with an unfinished character. Exit_Cause := Incomplete; end if; File.Ended := True; exit Read_Line; end if; Append (File.Line_Break_Buffer, To_EAstring (+Buffer, File.Encoding)); end; else -- The file has a variable-width or unknown encoding. We must -- read one byte at a time and transcode to find the line break -- characters. declare Pos : Stream_Element_Offset := 1; Buffer_Last : Stream_Element_Offset; Source_Last : Positive; Target : Byte_Sequence (1 .. 4); Target_Last : Positive; Converter_Status : Conversion_Stop_Cause; begin Read_Character : loop Read (Stream (F.all).all, Buffer.all (Pos .. Pos), Buffer_Last); if Buffer_Last < Pos then -- End of file. if Pos = 1 then -- Clean end. Exit_Cause := End_Of_File; else -- The file ended with an unfinished character. Exit_Cause := Incomplete; end if; File.Ended := True; exit Read_Line; end if; Convert (File.Converter, +Buffer.all (1 .. Pos), Target, Source_Last, Target_Last, Converter_Status); case Converter_Status is when All_Done => -- The whole character has been read. exit Read_Character; when Incomplete => -- Read another byte and try again. Pos := Pos + 1; if Pos > Buffer'Last then Double (Buffer); end if; when Inconvertible => -- Stop with error state. Exit_Cause := Invalid; exit Read_Line; when Target_Full => -- Won't happen, because Target is four bytes and -- File.Converter converts to UCS-4. null; end case; end loop Read_Character; Append (File.Line_Break_Buffer, To_EAstring (Target, UCS_4)); end; end if; if Finishing_Line_Break then if Is_Line_Break (File.Line_Break_Buffer, File) then -- The character we just read completes the previous line's -- terminating line break. Discard the line break. Tail (File.Line_Break_Buffer, 0); -- Keep the space. else -- The previous line's terminating line break was already -- complete. Keep the last character in the line break buffer -- to process it the normal way. Tail (File.Line_Break_Buffer, 1); end if; Finishing_Line_Break := False; end if; if Is_Line_Break (File.Line_Break_Buffer, File) then -- The line has ended and no more should be read now, but the -- line break might not end here. if (not File.Long_Line_Breaks) or else Length (File.Line_Break_Buffer) > 1 then -- The line break ends here, so there is no need to keep it. Tail (File.Line_Break_Buffer, 0); -- Keep the space. end if; Exit_Cause := All_Done; exit Read_Line; elsif not Is_Line_Break_Head (File.Line_Break_Buffer, File) then Append (Item, File.Line_Break_Buffer); Tail (File.Line_Break_Buffer, 0); -- Keep the space. end if; end loop Read_Line; if not Is_Line_Break (File.Line_Break_Buffer, File) then Append (Item, File.Line_Break_Buffer); Tail (File.Line_Break_Buffer, 0); end if; if Exit_Cause = End_Of_File and then Length (Item) > 0 then -- The last line in the file didn't end with a line break. This -- isn't considered an error, so deliver the line normally and don't -- signal end of file until the next read attempt. Exit_Cause := All_Done; end if; Free (Buffer); exception when others => Free (Buffer); raise; end Get_Line; procedure Get_Line (File : in out EAstream; Item : out EAstring) is Exit_Cause : Read_Stop_Cause; begin Get_Line (File, Item, Exit_Cause); case Exit_Cause is when Incomplete => raise Incomplete_Byte_Sequence; when Invalid => raise Invalid_Byte_Sequence; when End_Of_File => raise End_Error; when All_Done => null; end case; end Get_Line; procedure Get_Line (Item : out EAstring) is begin Get_Line (Current_Input.all, Item); end Get_Line; ---------------- -- Initialize -- ---------------- overriding procedure Initialize (Object : in out EAstream) is begin Object.Line_Breaks := new Line_Break_Array'(Known_Line_Breaks); end Initialize; ------------------- -- Is_Line_Break -- ------------------- function Is_Line_Break (Item : EAstring; File : EAstream) return Boolean is begin for Index in File.Line_Breaks'Range loop declare Current : Line_Break_Record renames File.Line_Breaks.all (Index); begin if Current.Possible and then Item = Current.String then return True; end if; end; end loop; return False; end Is_Line_Break; ------------------------ -- Is_Line_Break_Head -- ------------------------ function Is_Line_Break_Head (Item : EAstring; File : EAstream) return Boolean is begin if File.Long_Line_Breaks and then Length (Item) = 1 then for Index in File.Line_Breaks'Range loop declare Current : Line_Break_Record renames File.Line_Breaks.all ( Index); begin if Current.Possible and then Length (Current.String) = 2 and then Item = Head (Current.String, 1) then return True; end if; end; end loop; end if; return False; end Is_Line_Break_Head; ------------- -- Is_Open -- ------------- overriding function Is_Open (File : in EAfile) return Boolean is begin return Stream_IO.Is_Open (File.Base_File); end Is_Open; overriding function Is_Open (File : in Stream_EAstream) return Boolean is begin return File.Stream /= null; end Is_Open; ---------------- -- Line_Break -- ---------------- function Line_Break (File : in EAstream) return EAstring is begin return File.Line_Break; end Line_Break; ---------- -- Mode -- ---------- function Mode (File : in EAfile) return File_Mode is begin return Stream_IO.Mode (File.Base_File); end Mode; ---------- -- Name -- ---------- function Name (File : in EAfile) return EAstring is begin return To_EAstring (Fake_String_To_Byte_Sequence (Stream_IO.Name (File.Base_File)), OS_Encoding); end Name; -------------- -- New_Line -- -------------- procedure New_Line (File : in EAstream; Spacing : in Positive := 1) is type P is access constant EAstream'Class; F : constant P := File'Access; -- The reason for P and F is that Gnat says the call "Stream(File)" is not -- dispatching. begin Write (Stream (F.all).all, +Bytes (Transcode (Spacing * File.Line_Break, File.Encoding))); -- (Line_Break should be in the right encoding already, but let -- Transcode check just to be safe.) end New_Line; procedure New_Line (Spacing : in Positive := 1) is begin New_Line (Current_Output.all, Spacing); end New_Line; ---------- -- Open -- ---------- procedure Open (File : in out EAfile; Mode : in File_Mode; Name : in EAstring; Encoding : in Character_Encoding := OS_Encoding; Form : in String := "") is begin Stream_IO.Open (File.Base_File, Mode, Byte_Sequence_To_Fake_String (Bytes (Transcode (Name, OS_Encoding))), Form); if Mode = In_File and then not Fixed_Width (Encoding) then File.Converter := Open_Converter (From => Encoding, To => UCS_4); end if; File.Encoding := Encoding; if Mode = In_File then Transcode (File.Line_Breaks.all, Encoding_Reading (File)); else Transcode (File.Line_Break, Encoding); end if; Tail (File.Line_Break_Buffer, 0); File.Ended := False; exception when Unsupported_Conversion => Stream_IO.Close (File.Base_File); raise; end Open; --------- -- Put -- --------- procedure Put (File : in EAstream; Item : in EAstring) is type P is access constant EAstream'Class; F : constant P := File'Access; -- The reason for P and F is that Gnat says the call "Stream(File)" is not -- dispatching. begin Write (Stream (F.all).all, +Bytes (Transcode (Item, File.Encoding))); end Put; procedure Put (Item : in EAstring) is begin Put (Current_Output.all, Item); end Put; -------------- -- Put_Line -- -------------- procedure Put_Line (File : in EAstream; Item : in EAstring) is type P is access constant EAstream'Class; F : constant P := File'Access; -- The reason for P and F is that Gnat says the call "Stream(File)" is not -- dispatching. begin Write (Stream (F.all).all, +(Bytes (Transcode (Item, File.Encoding)) & Bytes (Transcode (File.Line_Break, File.Encoding)))); -- (Line_Break should be in the right encoding already, but let -- Transcode check just to be safe.) end Put_Line; procedure Put_Line (Item : in EAstring) is begin Put_Line (Current_Output.all, Item); end Put_Line; ---------------------------- -- Recognized_Line_Breaks -- ---------------------------- function Recognized_Line_Breaks (File : in EAstream) return EAstring_Array is Result : EAstring_Array (File.Line_Breaks'Range); begin for Index in Result'Range loop Result (Index) := File.Line_Breaks.all (Index).String; end loop; return Result; end Recognized_Line_Breaks; ----------- -- Reset -- ----------- procedure Reset (File : in out EAfile; Mode : in File_Mode; Encoding : in Character_Encoding) is Temp : Converter; begin if Mode = In_File then -- Nothing is changed if Open_Converter or Reset fails. if Fixed_Width (Encoding) then Temp := Null_Converter; else Temp := Open_Converter (From => Encoding, To => UCS_4); end if; begin Stream_IO.Reset (File.Base_File, Mode); exception when others => Close_Converter (Temp); raise; end; Close_Converter (File.Converter); File.Converter := Temp; if File.Converter = Null_Converter then Transcode (File.Line_Breaks.all, Encoding); else Transcode (File.Line_Breaks.all, UCS_4); end if; else Stream_IO.Reset (File.Base_File, Mode); Close_Converter (File.Converter); Transcode (File.Line_Break, Encoding); end if; File.Encoding := Encoding; Tail (File.Line_Break_Buffer, 0); File.Ended := False; end Reset; procedure Reset (File : in out EAfile; Mode : in File_Mode) is begin Stream_IO.Reset (File.Base_File, Mode); if Mode = In_File then if File.Converter = Null_Converter then if not Fixed_Width (File.Encoding) then File.Converter := Open_Converter (From => File.Encoding, To => UCS_4); end if; else Reset_Converter (File.Converter); end if; Transcode (File.Line_Breaks.all, Encoding_Reading (File)); else Close_Converter (File.Converter); Transcode (File.Line_Break, File.Encoding); end if; Tail (File.Line_Break_Buffer, 0); File.Ended := False; end Reset; procedure Reset (File : in out EAfile) is begin Stream_IO.Reset (File.Base_File); if File.Converter /= Null_Converter then Reset_Converter (File.Converter); end if; Tail (File.Line_Break_Buffer, 0); File.Ended := False; end Reset; ------------------ -- Set_Encoding -- ------------------ procedure Set_Encoding (File : in out EAstream; Encoding : in Character_Encoding) is Temp : Converter; begin -- Nothing is changed if Open_Converter fails. if Fixed_Width (Encoding) then Temp := Null_Converter; Transcode (File.Line_Breaks.all, Encoding); else Temp := Open_Converter (From => Encoding, To => UCS_4); Transcode (File.Line_Breaks.all, UCS_4); end if; Close_Converter (File.Converter); File.Converter := Temp; File.Encoding := Encoding; Transcode (File.Line_Break, Encoding); end Set_Encoding; overriding procedure Set_Encoding (File : in out EAfile; Encoding : in Character_Encoding) is begin if Mode (File) = In_File then Set_Encoding (EAstream (File), Encoding); else File.Encoding := Encoding; Transcode (File.Line_Break, Encoding); end if; end Set_Encoding; -------------------- -- Set_Line_Break -- -------------------- procedure Set_Line_Break (File : in out EAstream; Line_Break : in EAstring) is begin File.Line_Break := Transcode (Line_Break, File.Encoding); end Set_Line_Break; -------------------------------- -- Set_Recognized_Line_Breaks -- -------------------------------- procedure Set_Recognized_Line_Breaks (File : in out EAstream; Line_Breaks : in EAstring_Array) is procedure Deallocate is new Ada.Unchecked_Deallocation ( Line_Break_Array, Line_Break_Pointer); begin Deallocate (File.Line_Breaks); File.Line_Breaks := new Line_Break_Array (Line_Breaks'Range); File.Long_Line_Breaks := False; for Index in Line_Breaks'Range loop case Length (Line_Breaks (Index)) is when 1 => null; when 2 => File.Long_Line_Breaks := True; when others => raise Invalid_Line_Break; end case; -- Convert the line break to the same encoding as characters from -- the file will have when they are compared to the line breaks. declare Current : Line_Break_Record renames File.Line_Breaks.all (Index); begin Current.String := Line_Breaks (Index); Transcode (Current.String, Encoding_Reading (File)); Current.Possible := True; exception when Conversion_Impossible => Current.Possible := False; end; end loop; end Set_Recognized_Line_Breaks; --------------- -- Skip_Line -- --------------- procedure Skip_Line (File : in out EAstream; Spacing : in Positive := 1) is Trash : EAstring; begin for Counter in 1 .. Spacing loop Get_Line (File, Trash); end loop; end Skip_Line; procedure Skip_Line (Spacing : in Positive := 1) is begin Skip_Line (Current_Input.all, Spacing); end Skip_Line; ----------------------------------------------- -- the default input, output and error files -- ----------------------------------------------- Standard_In : aliased Stream_EAstream; Standard_Out : aliased Stream_EAstream; Standard_Err : aliased Stream_EAstream; function Standard_Error return EAstream_Pointer is begin return Standard_Err'Access; end Standard_Error; function Standard_Input return EAstream_Pointer is begin return Standard_In'Access; end Standard_Input; function Standard_Output return EAstream_Pointer is begin return Standard_Out'Access; end Standard_Output; ------------ -- Stream -- ------------ overriding function Stream (File : EAfile) return Stream_IO.Stream_Access is begin return Stream_IO.Stream (File.Base_File); end Stream; overriding function Stream (File : Stream_EAstream) return Stream_IO.Stream_Access is begin if File.Stream = null then raise Status_Error; else return File.Stream; end if; end Stream; --------------- -- Transcode -- --------------- procedure Transcode (Item : in out Line_Break_Array; New_Encoding : in Character_Encoding) is begin for Index in Item'Range loop declare Current : Line_Break_Record renames Item (Index); begin Transcode (Current.String, New_Encoding); Current.Possible := True; exception when Conversion_Impossible => Current.Possible := False; end; end loop; end Transcode; use Ada.Text_IO.Text_Streams; begin Connect (Standard_In, Stream_IO.Stream_Access (Stream (Ada.Text_IO.Standard_Input))); Connect (Standard_Out, Stream_IO.Stream_Access (Stream (Ada.Text_IO.Standard_Output))); Connect (Standard_Err, Stream_IO.Stream_Access (Stream (Ada.Text_IO.Standard_Error))); end AdaCL.EAstrings.IO;