1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2000-2010, AdaCore --
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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
35 -- This is needed because the pragmas Warnings (Off) in Current_Session and
36 -- Default_Session (see below) do not work when compiling clients of this
37 -- package that instantiate generic units herein.
41 with Ada.Strings.Unbounded;
42 with Ada.Strings.Fixed;
43 with Ada.Strings.Maps;
44 with Ada.Unchecked_Deallocation;
46 with GNAT.Directory_Operations;
47 with GNAT.Dynamic_Tables;
50 package body GNAT.AWK is
53 use Ada.Strings.Unbounded;
55 -----------------------
56 -- Local subprograms --
57 -----------------------
59 -- The following two subprograms provide a functional interface to the
60 -- two special session variables, that are manipulated explicitly by
61 -- Finalize, but must be declared after Finalize to prevent static
62 -- elaboration warnings.
64 function Get_Def return Session_Data_Access;
73 type Mode is abstract tagged null record;
74 -- This is the main type which is declared abstract. This type must be
75 -- derived for each split style.
77 type Mode_Access is access Mode'Class;
79 procedure Current_Line (S : Mode; Session : Session_Type)
81 -- Split current line of Session using split mode S
83 ------------------------
84 -- Split on separator --
85 ------------------------
87 type Separator (Size : Positive) is new Mode with record
88 Separators : String (1 .. Size);
91 procedure Current_Line
93 Session : Session_Type);
99 type Column (Size : Positive) is new Mode with record
100 Columns : Widths_Set (1 .. Size);
103 procedure Current_Line (S : Column; Session : Session_Type);
107 procedure Free is new Unchecked_Deallocation
108 (Split.Mode'Class, Split.Mode_Access);
114 type AWK_File is access String;
116 package File_Table is
117 new Dynamic_Tables (AWK_File, Natural, 1, 5, 50);
118 -- List of file names associated with a Session
120 procedure Free is new Unchecked_Deallocation (String, AWK_File);
126 type Field_Slice is record
130 -- This is a field slice (First .. Last) in session's current line
132 package Field_Table is
133 new Dynamic_Tables (Field_Slice, Natural, 1, 10, 100);
134 -- List of fields for the current line
140 -- Define all patterns style: exact string, regular expression, boolean
145 type Pattern is abstract tagged null record;
146 -- This is the main type which is declared abstract. This type must be
147 -- derived for each patterns style.
149 type Pattern_Access is access Pattern'Class;
153 Session : Session_Type) return Boolean
155 -- Returns True if P match for the current session and False otherwise
157 procedure Release (P : in out Pattern);
158 -- Release memory used by the pattern structure
160 --------------------------
161 -- Exact string pattern --
162 --------------------------
164 type String_Pattern is new Pattern with record
165 Str : Unbounded_String;
171 Session : Session_Type) return Boolean;
173 --------------------------------
174 -- Regular expression pattern --
175 --------------------------------
177 type Pattern_Matcher_Access is access Regpat.Pattern_Matcher;
179 type Regexp_Pattern is new Pattern with record
180 Regx : Pattern_Matcher_Access;
186 Session : Session_Type) return Boolean;
188 procedure Release (P : in out Regexp_Pattern);
190 ------------------------------
191 -- Boolean function pattern --
192 ------------------------------
194 type Callback_Pattern is new Pattern with record
195 Pattern : Pattern_Callback;
199 (P : Callback_Pattern;
200 Session : Session_Type) return Boolean;
204 procedure Free is new Unchecked_Deallocation
205 (Patterns.Pattern'Class, Patterns.Pattern_Access);
211 -- Define all action style : simple call, call with matches
215 type Action is abstract tagged null record;
216 -- This is the main type which is declared abstract. This type must be
217 -- derived for each action style.
219 type Action_Access is access Action'Class;
223 Session : Session_Type) is abstract;
224 -- Call action A as required
230 type Simple_Action is new Action with record
231 Proc : Action_Callback;
236 Session : Session_Type);
238 -------------------------
239 -- Action with matches --
240 -------------------------
242 type Match_Action is new Action with record
243 Proc : Match_Action_Callback;
248 Session : Session_Type);
252 procedure Free is new Unchecked_Deallocation
253 (Actions.Action'Class, Actions.Action_Access);
255 --------------------------
256 -- Pattern/Action table --
257 --------------------------
259 type Pattern_Action is record
260 Pattern : Patterns.Pattern_Access; -- If Pattern is True
261 Action : Actions.Action_Access; -- Action will be called
264 package Pattern_Action_Table is
265 new Dynamic_Tables (Pattern_Action, Natural, 1, 5, 50);
271 type Session_Data is record
272 Current_File : Text_IO.File_Type;
273 Current_Line : Unbounded_String;
274 Separators : Split.Mode_Access;
275 Files : File_Table.Instance;
276 File_Index : Natural := 0;
277 Fields : Field_Table.Instance;
278 Filters : Pattern_Action_Table.Instance;
281 Matches : Regpat.Match_Array (0 .. 100);
282 -- Latest matches for the regexp pattern
286 new Unchecked_Deallocation (Session_Data, Session_Data_Access);
292 procedure Finalize (Session : in out Session_Type) is
294 -- We release the session data only if it is not the default session
296 if Session.Data /= Get_Def then
297 -- Release separators
299 Free (Session.Data.Separators);
303 -- Since we have closed the current session, set it to point now to
304 -- the default session.
314 procedure Initialize (Session : in out Session_Type) is
316 Session.Data := new Session_Data;
318 -- Initialize separators
320 Session.Data.Separators :=
321 new Split.Separator'(Default_Separators'Length, Default_Separators);
323 -- Initialize all tables
325 File_Table.Init (Session.Data.Files);
326 Field_Table.Init (Session.Data.Fields);
327 Pattern_Action_Table.Init (Session.Data.Filters);
330 -----------------------
331 -- Session Variables --
332 -----------------------
334 Def_Session : Session_Type;
335 Cur_Session : Session_Type;
337 ----------------------
338 -- Private Services --
339 ----------------------
341 function Always_True return Boolean;
342 -- A function that always returns True
344 function Apply_Filters
345 (Session : Session_Type) return Boolean;
346 -- Apply any filters for which the Pattern is True for Session. It returns
347 -- True if a least one filters has been applied (i.e. associated action
348 -- callback has been called).
350 procedure Open_Next_File
351 (Session : Session_Type);
352 pragma Inline (Open_Next_File);
353 -- Open next file for Session closing current file if needed. It raises
354 -- End_Error if there is no more file in the table.
356 procedure Raise_With_Info
357 (E : Exceptions.Exception_Id;
359 Session : Session_Type);
360 pragma No_Return (Raise_With_Info);
361 -- Raises exception E with the message prepended with the current line
362 -- number and the filename if possible.
364 procedure Read_Line (Session : Session_Type);
365 -- Read a line for the Session and set Current_Line
367 procedure Split_Line (Session : Session_Type);
368 -- Split session's Current_Line according to the session separators and
369 -- set the Fields table. This procedure can be called at any time.
371 ----------------------
372 -- Private Packages --
373 ----------------------
379 package body Actions is
387 Session : Session_Type)
389 pragma Unreferenced (Session);
400 Session : Session_Type)
403 A.Proc (Session.Data.Matches);
412 package body Patterns is
420 Session : Session_Type) return Boolean
423 return P.Str = Field (P.Rank, Session);
432 Session : Session_Type) return Boolean
434 use type Regpat.Match_Location;
437 (P.Regx.all, Field (P.Rank, Session), Session.Data.Matches);
438 return Session.Data.Matches (0) /= Regpat.No_Match;
446 (P : Callback_Pattern;
447 Session : Session_Type) return Boolean
449 pragma Unreferenced (Session);
451 return P.Pattern.all;
458 procedure Release (P : in out Pattern) is
459 pragma Unreferenced (P);
468 procedure Release (P : in out Regexp_Pattern) is
469 procedure Free is new Unchecked_Deallocation
470 (Regpat.Pattern_Matcher, Pattern_Matcher_Access);
481 package body Split is
489 procedure Current_Line (S : Separator; Session : Session_Type) is
490 Line : constant String := To_String (Session.Data.Current_Line);
491 Fields : Field_Table.Instance renames Session.Data.Fields;
492 Seps : constant Maps.Character_Set := Maps.To_Set (S.Separators);
498 -- First field start here
502 -- Record the first field start position which is the first character
505 Field_Table.Increment_Last (Fields);
506 Fields.Table (Field_Table.Last (Fields)).First := Start;
509 -- Look for next separator
512 (Source => Line (Start .. Line'Last),
517 Fields.Table (Field_Table.Last (Fields)).Last := Stop - 1;
519 -- If separators are set to the default (space and tab) we skip
520 -- all spaces and tabs following current field.
522 if S.Separators = Default_Separators then
524 (Line (Stop + 1 .. Line'Last),
525 Maps.To_Set (Default_Separators),
537 -- Record in the field table the start of this new field
539 Field_Table.Increment_Last (Fields);
540 Fields.Table (Field_Table.Last (Fields)).First := Start;
544 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
551 procedure Current_Line (S : Column; Session : Session_Type) is
552 Line : constant String := To_String (Session.Data.Current_Line);
553 Fields : Field_Table.Instance renames Session.Data.Fields;
554 Start : Positive := Line'First;
557 -- Record the first field start position which is the first character
560 for C in 1 .. S.Columns'Length loop
562 Field_Table.Increment_Last (Fields);
564 Fields.Table (Field_Table.Last (Fields)).First := Start;
566 Start := Start + S.Columns (C);
568 Fields.Table (Field_Table.Last (Fields)).Last := Start - 1;
572 -- If there is some remaining character on the line, add them in a
575 if Start - 1 < Line'Length then
577 Field_Table.Increment_Last (Fields);
579 Fields.Table (Field_Table.Last (Fields)).First := Start;
581 Fields.Table (Field_Table.Last (Fields)).Last := Line'Last;
593 Session : Session_Type)
595 Files : File_Table.Instance renames Session.Data.Files;
598 if OS_Lib.Is_Regular_File (Filename) then
599 File_Table.Increment_Last (Files);
600 Files.Table (File_Table.Last (Files)) := new String'(Filename);
603 (File_Error'Identity,
604 "File " & Filename & " not found.",
614 Add_File (Filename, Cur_Session);
624 Number_Of_Files_Added : out Natural;
625 Session : Session_Type)
627 use Directory_Operations;
630 Filename : String (1 .. 200);
634 Number_Of_Files_Added := 0;
636 Open (Dir, Directory);
639 Read (Dir, Filename, Last);
642 Add_File (Filename (1 .. Last), Session);
643 Number_Of_Files_Added := Number_Of_Files_Added + 1;
651 (File_Error'Identity,
652 "Error scanning directory " & Directory
653 & " for files " & Filenames & '.',
660 Number_Of_Files_Added : out Natural)
664 Add_Files (Directory, Filenames, Number_Of_Files_Added, Cur_Session);
671 function Always_True return Boolean is
680 function Apply_Filters
681 (Session : Session_Type) return Boolean
683 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
684 Results : Boolean := False;
687 -- Iterate through the filters table, if pattern match call action
689 for F in 1 .. Pattern_Action_Table.Last (Filters) loop
690 if Patterns.Match (Filters.Table (F).Pattern.all, Session) then
692 Actions.Call (Filters.Table (F).Action.all, Session);
703 procedure Close (Session : Session_Type) is
704 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
705 Files : File_Table.Instance renames Session.Data.Files;
708 -- Close current file if needed
710 if Text_IO.Is_Open (Session.Data.Current_File) then
711 Text_IO.Close (Session.Data.Current_File);
714 -- Release Filters table
716 for F in 1 .. Pattern_Action_Table.Last (Filters) loop
717 Patterns.Release (Filters.Table (F).Pattern.all);
718 Free (Filters.Table (F).Pattern);
719 Free (Filters.Table (F).Action);
722 for F in 1 .. File_Table.Last (Files) loop
723 Free (Files.Table (F));
726 File_Table.Set_Last (Session.Data.Files, 0);
727 Field_Table.Set_Last (Session.Data.Fields, 0);
728 Pattern_Action_Table.Set_Last (Session.Data.Filters, 0);
730 Session.Data.NR := 0;
731 Session.Data.FNR := 0;
732 Session.Data.File_Index := 0;
733 Session.Data.Current_Line := Null_Unbounded_String;
736 ---------------------
737 -- Current_Session --
738 ---------------------
740 function Current_Session return Session_Type is
742 pragma Warnings (Off);
744 -- ???The above return statement violates the Ada 2005 rule forbidding
745 -- copying of limited objects (see RM-7.5(2.8/2)). When compiled with
746 -- -gnatg, the compiler gives a warning instead of an error, so we can
748 pragma Warnings (On);
751 ---------------------
752 -- Default_Session --
753 ---------------------
755 function Default_Session return Session_Type is
757 pragma Warnings (Off);
759 -- ???The above return statement violates the Ada 2005 rule forbidding
760 -- copying of limited objects (see RM-7.5(2.8/2)). When compiled with
761 -- -gnatg, the compiler gives a warning instead of an error, so we can
763 pragma Warnings (On);
770 function Discrete_Field
772 Session : Session_Type) return Discrete
775 return Discrete'Value (Field (Rank, Session));
778 function Discrete_Field_Current_Session
779 (Rank : Count) return Discrete is
780 function Do_It is new Discrete_Field (Discrete);
782 return Do_It (Rank, Cur_Session);
783 end Discrete_Field_Current_Session;
790 (Session : Session_Type) return Boolean
793 return Session.Data.File_Index = File_Table.Last (Session.Data.Files)
794 and then End_Of_File (Session);
801 return End_Of_Data (Cur_Session);
809 (Session : Session_Type) return Boolean
812 return Text_IO.End_Of_File (Session.Data.Current_File);
819 return End_Of_File (Cur_Session);
828 Session : Session_Type) return String
830 Fields : Field_Table.Instance renames Session.Data.Fields;
833 if Rank > Number_Of_Fields (Session) then
835 (Field_Error'Identity,
836 "Field number" & Count'Image (Rank) & " does not exist.",
841 -- Returns the whole line, this is what $0 does under Session_Type
843 return To_String (Session.Data.Current_Line);
846 return Slice (Session.Data.Current_Line,
847 Fields.Table (Positive (Rank)).First,
848 Fields.Table (Positive (Rank)).Last);
853 (Rank : Count) return String
856 return Field (Rank, Cur_Session);
861 Session : Session_Type) return Integer
864 return Integer'Value (Field (Rank, Session));
867 when Constraint_Error =>
869 (Field_Error'Identity,
870 "Field number" & Count'Image (Rank)
871 & " cannot be converted to an integer.",
876 (Rank : Count) return Integer
879 return Field (Rank, Cur_Session);
884 Session : Session_Type) return Float
887 return Float'Value (Field (Rank, Session));
890 when Constraint_Error =>
892 (Field_Error'Identity,
893 "Field number" & Count'Image (Rank)
894 & " cannot be converted to a float.",
899 (Rank : Count) return Float
902 return Field (Rank, Cur_Session);
910 (Session : Session_Type) return String
912 Files : File_Table.Instance renames Session.Data.Files;
915 if Session.Data.File_Index = 0 then
918 return Files.Table (Session.Data.File_Index).all;
926 return File (Cur_Session);
933 procedure For_Every_Line
934 (Separators : String := Use_Current;
935 Filename : String := Use_Current;
936 Callbacks : Callback_Mode := None;
937 Session : Session_Type)
942 Open (Separators, Filename, Session);
944 while not End_Of_Data (Session) loop
946 Split_Line (Session);
948 if Callbacks in Only .. Pass_Through then
951 pragma Unreferenced (Discard);
953 Discard := Apply_Filters (Session);
957 if Callbacks /= Only then
967 procedure For_Every_Line_Current_Session
968 (Separators : String := Use_Current;
969 Filename : String := Use_Current;
970 Callbacks : Callback_Mode := None)
972 procedure Do_It is new For_Every_Line (Action);
974 Do_It (Separators, Filename, Callbacks, Cur_Session);
975 end For_Every_Line_Current_Session;
982 (Callbacks : Callback_Mode := None;
983 Session : Session_Type)
985 Filter_Active : Boolean;
988 if not Text_IO.Is_Open (Session.Data.Current_File) then
994 Split_Line (Session);
1002 Filter_Active := Apply_Filters (Session);
1003 exit when not Filter_Active;
1005 when Pass_Through =>
1006 Filter_Active := Apply_Filters (Session);
1014 (Callbacks : Callback_Mode := None)
1017 Get_Line (Callbacks, Cur_Session);
1020 ----------------------
1021 -- Number_Of_Fields --
1022 ----------------------
1024 function Number_Of_Fields
1025 (Session : Session_Type) return Count
1028 return Count (Field_Table.Last (Session.Data.Fields));
1029 end Number_Of_Fields;
1031 function Number_Of_Fields
1035 return Number_Of_Fields (Cur_Session);
1036 end Number_Of_Fields;
1038 --------------------------
1039 -- Number_Of_File_Lines --
1040 --------------------------
1042 function Number_Of_File_Lines
1043 (Session : Session_Type) return Count
1046 return Count (Session.Data.FNR);
1047 end Number_Of_File_Lines;
1049 function Number_Of_File_Lines
1053 return Number_Of_File_Lines (Cur_Session);
1054 end Number_Of_File_Lines;
1056 ---------------------
1057 -- Number_Of_Files --
1058 ---------------------
1060 function Number_Of_Files
1061 (Session : Session_Type) return Natural
1063 Files : File_Table.Instance renames Session.Data.Files;
1065 return File_Table.Last (Files);
1066 end Number_Of_Files;
1068 function Number_Of_Files
1072 return Number_Of_Files (Cur_Session);
1073 end Number_Of_Files;
1075 ---------------------
1076 -- Number_Of_Lines --
1077 ---------------------
1079 function Number_Of_Lines
1080 (Session : Session_Type) return Count
1083 return Count (Session.Data.NR);
1084 end Number_Of_Lines;
1086 function Number_Of_Lines
1090 return Number_Of_Lines (Cur_Session);
1091 end Number_Of_Lines;
1098 (Separators : String := Use_Current;
1099 Filename : String := Use_Current;
1100 Session : Session_Type)
1103 if Text_IO.Is_Open (Session.Data.Current_File) then
1104 raise Session_Error;
1107 if Filename /= Use_Current then
1108 File_Table.Init (Session.Data.Files);
1109 Add_File (Filename, Session);
1112 if Separators /= Use_Current then
1113 Set_Field_Separators (Separators, Session);
1116 Open_Next_File (Session);
1124 (Separators : String := Use_Current;
1125 Filename : String := Use_Current)
1128 Open (Separators, Filename, Cur_Session);
1131 --------------------
1132 -- Open_Next_File --
1133 --------------------
1135 procedure Open_Next_File
1136 (Session : Session_Type)
1138 Files : File_Table.Instance renames Session.Data.Files;
1141 if Text_IO.Is_Open (Session.Data.Current_File) then
1142 Text_IO.Close (Session.Data.Current_File);
1145 Session.Data.File_Index := Session.Data.File_Index + 1;
1147 -- If there are no mores file in the table, raise End_Error
1149 if Session.Data.File_Index > File_Table.Last (Files) then
1154 (File => Session.Data.Current_File,
1155 Name => Files.Table (Session.Data.File_Index).all,
1156 Mode => Text_IO.In_File);
1164 (Separators : String := Use_Current;
1165 Filename : String := Use_Current;
1166 Session : Session_Type)
1168 Filter_Active : Boolean;
1169 pragma Unreferenced (Filter_Active);
1172 Open (Separators, Filename, Session);
1174 while not End_Of_Data (Session) loop
1175 Get_Line (None, Session);
1176 Filter_Active := Apply_Filters (Session);
1183 (Separators : String := Use_Current;
1184 Filename : String := Use_Current)
1187 Parse (Separators, Filename, Cur_Session);
1190 ---------------------
1191 -- Raise_With_Info --
1192 ---------------------
1194 procedure Raise_With_Info
1195 (E : Exceptions.Exception_Id;
1197 Session : Session_Type)
1199 function Filename return String;
1200 -- Returns current filename and "??" if this information is not
1203 function Line return String;
1204 -- Returns current line number without the leading space
1210 function Filename return String is
1211 File : constant String := AWK.File (Session);
1224 function Line return String is
1225 L : constant String := Natural'Image (Session.Data.FNR);
1227 return L (2 .. L'Last);
1230 -- Start of processing for Raise_With_Info
1233 Exceptions.Raise_Exception
1235 '[' & Filename & ':' & Line & "] " & Message);
1236 raise Constraint_Error; -- to please GNAT as this is a No_Return proc
1237 end Raise_With_Info;
1243 procedure Read_Line (Session : Session_Type) is
1245 function Read_Line return String;
1246 -- Read a line in the current file. This implementation is recursive
1247 -- and does not have a limitation on the line length.
1249 NR : Natural renames Session.Data.NR;
1250 FNR : Natural renames Session.Data.FNR;
1256 function Read_Line return String is
1257 Buffer : String (1 .. 1_024);
1261 Text_IO.Get_Line (Session.Data.Current_File, Buffer, Last);
1263 if Last = Buffer'Last then
1264 return Buffer & Read_Line;
1266 return Buffer (1 .. Last);
1270 -- Start of processing for Read_Line
1273 if End_Of_File (Session) then
1274 Open_Next_File (Session);
1278 Session.Data.Current_Line := To_Unbounded_String (Read_Line);
1291 Action : Action_Callback;
1292 Session : Session_Type)
1294 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1295 U_Pattern : constant Unbounded_String := To_Unbounded_String (Pattern);
1298 Pattern_Action_Table.Increment_Last (Filters);
1300 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1301 (Pattern => new Patterns.String_Pattern'(U_Pattern, Field),
1302 Action => new Actions.Simple_Action'(Proc => Action));
1308 Action : Action_Callback)
1311 Register (Field, Pattern, Action, Cur_Session);
1316 Pattern : GNAT.Regpat.Pattern_Matcher;
1317 Action : Action_Callback;
1318 Session : Session_Type)
1320 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1322 A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1323 new Regpat.Pattern_Matcher'(Pattern);
1325 Pattern_Action_Table.Increment_Last (Filters);
1327 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1328 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1329 Action => new Actions.Simple_Action'(Proc => Action));
1334 Pattern : GNAT.Regpat.Pattern_Matcher;
1335 Action : Action_Callback)
1338 Register (Field, Pattern, Action, Cur_Session);
1343 Pattern : GNAT.Regpat.Pattern_Matcher;
1344 Action : Match_Action_Callback;
1345 Session : Session_Type)
1347 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1349 A_Pattern : constant Patterns.Pattern_Matcher_Access :=
1350 new Regpat.Pattern_Matcher'(Pattern);
1352 Pattern_Action_Table.Increment_Last (Filters);
1354 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1355 (Pattern => new Patterns.Regexp_Pattern'(A_Pattern, Field),
1356 Action => new Actions.Match_Action'(Proc => Action));
1361 Pattern : GNAT.Regpat.Pattern_Matcher;
1362 Action : Match_Action_Callback)
1365 Register (Field, Pattern, Action, Cur_Session);
1369 (Pattern : Pattern_Callback;
1370 Action : Action_Callback;
1371 Session : Session_Type)
1373 Filters : Pattern_Action_Table.Instance renames Session.Data.Filters;
1376 Pattern_Action_Table.Increment_Last (Filters);
1378 Filters.Table (Pattern_Action_Table.Last (Filters)) :=
1379 (Pattern => new Patterns.Callback_Pattern'(Pattern => Pattern),
1380 Action => new Actions.Simple_Action'(Proc => Action));
1384 (Pattern : Pattern_Callback;
1385 Action : Action_Callback)
1388 Register (Pattern, Action, Cur_Session);
1392 (Action : Action_Callback;
1393 Session : Session_Type)
1396 Register (Always_True'Access, Action, Session);
1400 (Action : Action_Callback)
1403 Register (Action, Cur_Session);
1410 procedure Set_Current (Session : Session_Type) is
1412 Cur_Session.Data := Session.Data;
1415 --------------------------
1416 -- Set_Field_Separators --
1417 --------------------------
1419 procedure Set_Field_Separators
1420 (Separators : String := Default_Separators;
1421 Session : Session_Type)
1424 Free (Session.Data.Separators);
1426 Session.Data.Separators :=
1427 new Split.Separator'(Separators'Length, Separators);
1429 -- If there is a current line read, split it according to the new
1432 if Session.Data.Current_Line /= Null_Unbounded_String then
1433 Split_Line (Session);
1435 end Set_Field_Separators;
1437 procedure Set_Field_Separators
1438 (Separators : String := Default_Separators)
1441 Set_Field_Separators (Separators, Cur_Session);
1442 end Set_Field_Separators;
1444 ----------------------
1445 -- Set_Field_Widths --
1446 ----------------------
1448 procedure Set_Field_Widths
1449 (Field_Widths : Widths_Set;
1450 Session : Session_Type)
1453 Free (Session.Data.Separators);
1455 Session.Data.Separators :=
1456 new Split.Column'(Field_Widths'Length, Field_Widths);
1458 -- If there is a current line read, split it according to
1459 -- the new separators.
1461 if Session.Data.Current_Line /= Null_Unbounded_String then
1462 Split_Line (Session);
1464 end Set_Field_Widths;
1466 procedure Set_Field_Widths
1467 (Field_Widths : Widths_Set)
1470 Set_Field_Widths (Field_Widths, Cur_Session);
1471 end Set_Field_Widths;
1477 procedure Split_Line (Session : Session_Type) is
1478 Fields : Field_Table.Instance renames Session.Data.Fields;
1480 Field_Table.Init (Fields);
1481 Split.Current_Line (Session.Data.Separators.all, Session);
1488 function Get_Def return Session_Data_Access is
1490 return Def_Session.Data;
1497 procedure Set_Cur is
1499 Cur_Session.Data := Def_Session.Data;
1503 -- We have declared two sessions but both should share the same data.
1504 -- The current session must point to the default session as its initial
1505 -- value. So first we release the session data then we set current
1506 -- session data to point to default session data.
1508 Free (Cur_Session.Data);
1509 Cur_Session.Data := Def_Session.Data;