j2ada_1.4.2_79a46634/src/fichsrc.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
--------------------------------------------------------------------------------
-- 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;