--------------------------------------------------------------------------------
-- NOM DU CSU (corps) : FichSrc.adb
-- AUTEUR DU CSU : P. Pignard
-- VERSION DU CSU : 1.0a
-- DATE DE LA DERNIERE MISE A JOUR : 18 août 2008
-- ROLE DU CSU : Unité de gestion de la lecture du source.
--
--
-- FONCTIONS EXPORTEES DU CSU :
--
--
-- FONCTIONS LOCALES DU CSU :
--
--
-- NOTES :
--
-- COPYRIGHT : (c) Pascal Pignard 2008
-- LICENCE : CeCILL V2 (http://www.cecill.info)
-- CONTACT : http://blady.pagesperso-orange.fr
--------------------------------------------------------------------------------
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Characters.Latin_1;
package body FichSrc is
-- Procédure donnant le nom et la ligne courante du fichier source.
procedure Status (Object : TSourceMgr; Name : out TText; Ligne : out Natural) is
begin
Name := FSplitName (Object.FName);
Ligne := Object.CptLigne;
end Status;
procedure FileRead (F : SrcFile.File_Type; Buffer : out Ttextbuff; Len : SrcFile.Count) is
Ch : Character;
begin
for Ind in 1 .. Len loop
SrcFile.Read (F, Ch);
Append (Buffer, Ch);
end loop;
exception
when E : others =>
Raise_Exception
(Exception_Identity (E),
"Erreur de lecture du fichier source : """ & SrcFile.Name (F) & """.");
end FileRead;
-- Procédure de lecture du contenu du fichier source.
procedure Open (Object : in out TSourceMgr; Name : TText) is
begin
Object.FName := Name;
Object.CptCar := 0;
Object.CptLigne := 1;
SrcFile.Open (Object.FRef, SrcFile.In_File, To_String (Name));
Object.FLen := SrcFile.Size (Object.FRef);
Put_Line ("Lecture de " & To_String (FSplitName (Name)) & " ...");
FileRead (Object.FRef, Object.TextBuff, Object.FLen);
SrcFile.Close (Object.FRef);
Append (Object.TextBuff, Ada.Characters.Latin_1.EOT);
Object.ChTemp := Element (Object.TextBuff, 1);
exception
when E : others =>
Raise_Exception
(Exception_Identity (E),
"Erreur d'ouverture du fichier source """ & To_String (Name) & """.");
end Open;
-- Procédure de lecture d'un caractère du buffer contenant le texte source.
-- Le caractère lu est dans Ch1, le suivant est dans Ch2.
procedure Read (Object : in out TSourceMgr; Ch1, Ch2 : out Character) is
begin
Ch1 := Object.ChTemp;
Object.CptCar := Object.CptCar + 1;
if Object.ChTemp = Ada.Characters.Latin_1.LF then
Object.CptLigne := Object.CptLigne + 1;
end if;
if Object.ChTemp /= Ada.Characters.Latin_1.EOT then
Object.ChTemp := Element (Object.TextBuff, Integer'Succ (Object.CptCar));
end if;
Ch2 := Object.ChTemp;
end Read;
-- Procédure de destruction du buffer.
procedure Close (Object : in out TSourceMgr) is
begin
Object.FName := NullTText;
Object.TextBuff := To_Unbounded_String ((1 => Ada.Characters.Latin_1.EOT));
end Close;
end FichSrc;